Logo 
Search:

MS Office Answers

Ask Question   UnAnswered
Home » Forum » MS Office       RSS Feeds
  Question Asked By: Deepu Ramani   on Dec 08 In MS Office Category.

  
Question Answered By: Sydney Thompson   on Dec 08

thanks for the sample code. 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

Share: 

 

This Question has 17 more answer(s). View Complete Question Thread

 


Tagged: