I was going to suggest copying the column  twice and delete the numbers  from
one and letters from the other, but your second one with the 3 in the first
word throws that idea out the window.



So it looks like you will have to break this down by words. Is there a
minimum length for the numbers and is "-" the only non numeric character in
the number?

yes, unfortunately the cell  contents could contain any mixture
of text  and numbers  (and other characters), but it's only when a 'string' of
9 numbers is recognised that I want the macro  to separate it from the rest.
And "-" will be the only non-numeric character contained within the number I
need recognised (when it is used), always at the same two positions
0-000000-0.

Thanks for the sample code - and thanks to everyone else for the code
samples & suggestions.

The sample code should work and you can refine it by changing



If IsNumeric(TmpStr) And Len(TmpStr) > 2 Then



To



If IsNumeric(TmpStr) And Len(Words(0)) = 9 Then



The first one just looks for a numeric string with more than two numbers.
The new line will look for a numeric string that has nine characters
(including optional dashes)

I'd go with SPLIT here and test to see if the resultant array elements have
a number for the first character.

This will point you in the right direction. You will need to make some
changes to fit what you need, such as having the final value go where
you want it, and an additional loop statement.



Dim sNumber As String

Dim sName As String

Dim sChr As String

Dim iLen As Integer

Dim i As Integer

Dim sValue As String



sValue = Range("B1").Value 'Place this within a loop statement, where
you move from row to row getting the next value

iLen = Len(sValue)



For i = 1 To iLen

sChr = Mid(sValue, i, 1)

If IsNumeric(sChr) Or sChr = "-" Then

sNumber = sNumber & sChr

Else

sName = sName & sChr

End If

Next

Below is the code (adapted from Craig's example) and it does exactly what I
need it to! If my coding looks more complicated than it needs to be, feel
free to tell me!


Sub ObtainAcNumber()

Dim strCellValue, strReference, strAcNum, strChr As String
Dim intRow, intCol, x As Integer

intRow = 2

Do While Cells(intRow, 1).Value <> "" ''' Loops through each cell  that
contains data

strCellValue = Cells(intRow, 7).Value

For x = 1 To Len(strCellValue) ''' Loops through each character in the
cell

strChr = Mid(strCellValue, x, 1)

If IsNumeric(strChr) Or strChr = "-" Then

''' Checks the length and format  of the numerical  string each
time a number is added

If (Left(strAcNum, 1) = "0" And Len(strAcNum) < 9) Or _
''' Format "000000000"

(Left(strAcNum, 1) <> "0" And Len(strAcNum) < 8) Or _
''' Format "00000000"

(InStr(strAcNum, "-") > 0 And Left(strAcNum, 1) = "0" And _
Len(strAcNum) < 11) Or _ ''' Format "00-000000-0" (not
exact, but sufficient)

(InStr(strAcNum, "-") > 0 And Left(strAcNum, 1) <> "0" And _
Len(strAcNum) < 10) Then ''' Format "0-000000-0" (not
exact, but sufficient)

strAcNum = strAcNum & strChr

If x = Len(strCellValue) And Len(strAcNum) < 8 Then
strAcNum = ""

End If

Else

''' If the numerical string has finished and is not at least 8
numbers in length, it is reset to ""

If strAcNum <> "" Then

If Len(strAcNum) < 8 Then strAcNum = ""

End If

strReference = strReference & strChr

End If

Next x

''' Removes the zero at the beginning of the numerical string, if
applicable

If Left(strAcNum, 1) = "0" Then strAcNum = Right(strAcNum, Len(strAcNum)
- 1)

If strAcNum <> "" Then
Cells(intRow, 6).Value = strAcNum
Cells(intRow,7).Value = strReference
End If

strReference = "": strAcNum = ""

intRow = intRow + 1

Loop

End Sub

That's a lot of code. I did a quick scan and it dos look correct, but I do
not have a high level of confidence with it. I would need more time to
review the code.



One key thing that is missing from this code (and mine) is a method of
verifiability. I would change the code so that the main part creates three
strings: the text  before the number (TBN), the number (N) and the text after
the number (TAN). At the very end of the code I would return trim(TBN+"
"+TBA) for the text, N for the number.



By combining the three strings, trim(trim(TBN+" "+N)+" "+TAN) as a
verification string you can check it against the original string. If they do
not match, then there is a problem with the code and you should display an
error message with the problem string.

Yes, I thought it looked like a lot of code too!

I like the verification idea, but unfortunately the data being checked won't
always fit neatly into three strings with the number in the middle -
sometimes there could be as many as 5 substrings in a cell  with the account
number reference at any position (the data examples I gave were simplified).
Also, an added verification step may not be necessary in this case, because
each account number will be checked on our inhouse system to ensure it is a
valid account number. But I'll play around with it today and see if I can
integrate something like that.

It will still work even if there are five substrings, as long as there is
only one number string. The code would still be breaking the string into
three parts, what is before the number, the number and what is after the
number. The stuff before and after the number may be able to be divided into
substrings, but the key to the splitting is the number. So you are only
talking about a maximum of three strings. The verification will still work
even if the number is the only thing in the string.

Here is an updated version with the verification. I also followed Lisa's
example and used more readable parameters.

Note: the code uses >7 rather than =9 because one of your examples used
eight digits.

Function GetNumber(OrigText As Variant, SelType As String) As String



' Place the following in the cell  to call the UDF

'

' =getnumber(A1,"Text")for the text  portion

' =getnumber(A1,"Number")for the number

'



Dim BeforeNumber As Boolean

Dim FullNumStr As String

Dim i As Long

Dim NumStr As String

Dim TxtAfter As String

Dim TxtBefore As String

Dim TmpStr As String

Dim Words As Variant

Dim WorkingText As String



WorkingText = Trim(OrigText)



NumStr = ""

TxtAfter = ""

TxtBefore = ""

BeforeNumber = True



' Split the string into an array of elements

Words = Split(WorkingText, " ")



For i = 0 To UBound(Words)



' Remove the dashes from a string that potentially may be a number

TmpStr = Replace(Words(i), "-", "")



' Is this a string of number and has the version with the dashes at
least eight characters?

If IsNumeric(TmpStr) And Len(Words(i)) > 7 Then

NumStr = TmpStr

FullNumStr = Words(i)

BeforeNumber = False

Else

TmpStr = " " + Words(i)

If BeforeNumber Then TxtBefore = TxtBefore + TmpStr Else TxtAfter =
TxtAfter + TmpStr

End If



Next i



' Verification

TmpStr = Trim(Trim(TxtBefore + " " + FullNumStr) + TxtAfter)



If TmpStr <> OrigText Then

GetNumber = "Problem with routine"

Else

GetNumber = IIf(SelType = "Number", NumStr, Trim(TxtBefore + TxtAfter))

End If



End Function

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

I like the UDF approach because it is simple, does not tie you down to a
specific relationship between cells  and is simple to implement. You can just
place the formula in one cell  and replicate it down the column.



If you prefer, having a value in a cell rather than a formula, you can
easily do a cut and Past Special.



One of the benefits of the verification is that it can highlight problems.
It is far easier to check a couple of flagged cells rather than all cells.
You will also know that the likelihood of false positive would be low.

Thanks for getting back to us with your actual solution ...
Interesting.

: Dim strCellValue, strReference, strAcNum, strChr As String
: Dim intRow, intCol, x, y As Integer, varElements As Variant

A note on Dim: If you look at the Example under Dim
in VBA help, you'll see that the above Dim statements
actually do this.

Dim strCellValue As Variant
Dim strReference As Variant
Dim strAcNum As Variant
Dim strChr As String

Dim intRow As Variant
Dim intCol As Variant
Dim x As Variant
Dim y As Integer

Dim varElements As Variant

I think you wanted this.

Dim strCellValue As String
Dim strReference As String
Dim strAcNum As String
Dim strChr As String

Dim intRow As Integer
Dim intCol As Integer
Dim x As Integer
Dim y As Integer

Dim varElements As Variant

Thanks ..... and all this time I've been thinking I was doing it the
right way! Appreciate you letting me know - time to go and change a few of
my macros!

Here is a UDF to get you started



Function GetNumber(text As Variant, n As Integer) As String



'=getnumber(A1,0)for the text

'=getnumber(A1,1)for the number



Dim i As Long

Dim NumStr As String

Dim txt As String

Dim TxtStr As String

Dim TmpStr As String

Dim Words As Variant



txt = Trim(text)



NumStr = ""

TxtStr = ""



Words = Split(txt, " ")

For i = 0 To UBound(Words)



TmpStr = Replace(Words(i), "-", "")



If IsNumeric(TmpStr) And Len(TmpStr) > 2 Then

NumStr = TmpStr

Else

TxtStr = TxtStr + IIf(i > 1, " ", "") + Words(i)

End If



Next i



GetNumber = IIf(n = 1, NumStr, TxtStr)



End Function

I had a similar problem and found that this function helped serve my
needs...

Public Sub StrTest()
Dim Strng As String, aChr As String, i As Integer, FirstStr As Boolean
Dim str1 As String, str2 As String, str3 As String

Strng = "123XYZ24"

str1 = "": str2 = "": str3 = "": FirstStr = True
For i = 1 To Len(Strng)
aChr = Mid(Strng, i, 1)
If InStr("0123456789", aChr) > 0 Then
If FirstStr Then str1 = str1 & aChr Else str3 = str3 & aChr
Else
FirstStr = False
str2 = str2 & aChr
End If
Next i

Debug.Print Strng, str1, str2, str3

End Sub

This is a perfect task for regular expressions. I've never used them in
Excel, but they seem to be there, as an add-in.

Have a look at this URL www.vbaexpress.com/kb/getarticle.php?kb_id=68
for a download that demonstrates the add-in.

I'm a complete novice at regular expressions, but an experienced RegExp'er
would trot out a match string for your patterns without even breaking a
sweat.

My preferred approach would be to create a match string that found
everything EXCEPT your numeric string and removed it, and placed the result
in the appropriate cell. This would leave you with your numeric string or
nothing.

The other cell  could be filled by using Replace to eliminate the numeric
string and one of its delimiting spaces if the numeric string cell is
non-empty. (Or just use the inverse of the RegExp if you prefer.)