I had another play with it this
week, and the final code in use is below, which uses some of the ideas
shared here.
I changed the variables to keep it consistent with other macros being used
at work, and I put the code in a sub-procedure rather than in a function - I
was very impressed with the function, but decided I would rather have the
actual values stored in cells, rather than a formula calling the function.
I didn't feel that verification was necessary in this case, because each
account number must be manually checked anyway to ensure it is a valid
account number. Also, cells often contain multiple numerical substrings, and
at times the account number reference will be contained within an
alpha-numerical substring, so I tried to cater for these situations, and so
far it seems to be working well.
Sub ObtainAcNum()
Dim strCellValue, strReference, strAcNum, strChr As String
Dim intRow, intCol, x, y As Integer, varElements As Variant
intRow = 2
Do While Cells(intRow, 1).Value <> ""
' Remove unnecessary dashes & spaces
strCellValue = Replace(Cells(intRow, 7).Value, "-", "")
Do Until InStr(strCellValue, " ") = 0
strCellValue = Replace(strCellValue, " ", " ")
Loop
Cells(intRow, 7).Value = strCellValue
' Split the string into an array of elements
varElements = Split(strCellValue, " ")
' Check each element for possible account number format
For x = 0 To UBound(varElements)
' Ignore substring containing "Txn" or "SPS"
If UCase(InStr(varElements(x), "TXN")) > 0 Or _
UCase(InStr(varElements(x), "SPS")) > 0 Then
' If substring in it's entirety is in account number format
ElseIf IsNumeric(varElements(x)) Then
If Len(varElements(x)) > 7 And Len(varElements(x)) < 10 Then
strAcNum = varElements(x)
Exit For
End If
' If substring is alpha-numerical but begins with at least 8 numbers
ElseIf IsNumeric(Left(varElements(x), 8)) And Len(varElements(x)) >
8 Then
For y = 1 To Len(varElements(x))
strChr = Mid(varElements(x), y, 1)
If Len(strAcNum) < 8 And IsNumeric(strChr) Then
strAcNum = strAcNum + strChr
If y = Len(varElements(x)) And strAcNum < 8 Then
strAcNum = ""
End If
Next y
' If substring is alpha-numerical but ends with at least 8 numbers
ElseIf IsNumeric(Right(varElements(x), 8)) And Len(varElements(x)) >
8 Then
For y = Len(varElements(x)) To 1 Step -1
strChr = Mid(varElements(x), y, 1)
If Len(strAcNum) < 8 And IsNumeric(strChr) Then
strAcNum = strChr + strAcNum
If y = 1 And strAcNum < 8 Then strAcNum = ""
End If
Next y
End If
Next x
Cells(intRow, 2).Value = strAcNum
strReference = "": strAcNum = ""
intRow = intRow + 1
Loop
End Sub