Problem with extracting multiple numbers series from text

[tudorr]

Hello. I really would need some big help with extracting multiple numbers series from text and I hope that someone can and will give me an advice.
I have a big column of text data in excel ( thousands of rows) where every cell contains multiple letters and number series.

Cells are not similar at all as formatting and length. Numbers series are placed in different positions of the text and in every cell there are from one to 20 series of numbers.

One cell looks like this :
A1: John Smith adress 123454 phone 754777755
B2: Adress 12343 Bob Innerside gets 1000 $

I would really need a VBA or a function to extract all these series of number, in a different column or in different columns, results being separated somehow ( comma for example)

I made some research and I only found an UDF called GetNumber, that can get me only ONE number series ( the first one met).

It looks likes this :

Function GetNumber(Cell As Range)
For N = 1 To Len(Cell)
If (Mid(Cell, N, 1) = " " Or N = Len(Cell)) And MyNumber <> "" Then
GetNumber = MyNumber
Exit Function
End If
If IsNumeric(Mid(Cell, N, 1)) And Mid(Cell, N, 1) <> " " Then
MyNumber = MyNumber & Mid(Cell, N, 1)
End If
Next N
End Function

I really don`t know how to modify it so I could get ALL the numbers series from the cell`s text.

Thank you for your attention and future help.

tudorr

 

[bertie]

Hi, and welcome to the forum.

Sheet1

<TABLE style="BACKGROUND-COLOR: #ffffff; PADDING-LEFT: 2pt; PADDING-RIGHT: 2pt; FONT-FAMILY: Calibri,Arial; FONT-SIZE: 11pt" border=1 cellSpacing=0 cellPadding=0><COLGROUP><COL style="WIDTH: 30px; FONT-WEIGHT: bold"><COL style="WIDTH: 315px"><COL style="WIDTH: 64px"><COL style="WIDTH: 73px"></COLGROUP><TBODY><TR style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt; FONT-WEIGHT: bold"><TD></TD><TD>A</TD><TD>B</TD><TD>C</TD></TR><TR style="HEIGHT: 18px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">1</TD><TD style="FONT-FAMILY: Verdana; FONT-SIZE: 10pt">John Smith adress 123454 phone 754777755 </TD><TD style="TEXT-ALIGN: right; BACKGROUND-COLOR: #ffff00">123454</TD><TD style="TEXT-ALIGN: right; BACKGROUND-COLOR: #ffff00">754777755 </TD></TR><TR style="HEIGHT: 18px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">2</TD><TD style="FONT-FAMILY: Verdana; FONT-SIZE: 10pt">Adress 12343 Bob Innerside gets 1000 $</TD><TD style="TEXT-ALIGN: right; BACKGROUND-COLOR: #ffff00">12343</TD><TD style="TEXT-ALIGN: right; BACKGROUND-COLOR: #ffff00">1000</TD></TR></TBODY></TABLE>



The code below will extract the numeric values from the text string in column A and place them into the adjacent columns, see highlighted above.

What the code does is Split the text string into an array then loops through the array to test for numeric values.

To use:
Make a copy of your workbook.
Press Alt + F11 to open the VBA Editor.
Double click the ThisWorkbook module in the Project Window on the left hand side.
Copy and paste the code below - edit where highlighted if necessary.
Press F5 to run.

[COLOR=darkblue]Sub[/COLOR] ParseData()
   [COLOR=darkblue]Dim[/COLOR] rng [COLOR=darkblue]As[/COLOR] Range     [COLOR=green]'range to process[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] arr [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Variant[/COLOR]   [COLOR=green]'array[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] i [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]        'loop index
   [COLOR=darkblue]Dim[/COLOR] col [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]      [COLOR=green]'column offset for output[/COLOR]
 
   [COLOR=darkblue]Set[/COLOR] rng = Sheets("[COLOR=red]Sheet1[/COLOR]").Range("[COLOR=red]A1[/COLOR]")
 
   [COLOR=darkblue]Do[/COLOR] [COLOR=darkblue]Until[/COLOR] rng = ""
      [COLOR=green]'split values into an array[/COLOR]
      [COLOR=green]'then loop through the array to determine if numeric[/COLOR]
      col = 0
      arr = Split(rng.Value, " ")
      [COLOR=darkblue]For[/COLOR] i = [COLOR=darkblue]LBound[/COLOR](arr) [COLOR=darkblue]To[/COLOR] [COLOR=darkblue]UBound[/COLOR](arr)
         [COLOR=darkblue]If[/COLOR] IsNumeric(arr(i)) [COLOR=darkblue]Then[/COLOR]
            [COLOR=green]'=================================[/COLOR]
            [COLOR=green]'any other test criteria goes here[/COLOR]
            [COLOR=green]'=================================[/COLOR]
            col = col + 1
            rng.Offset(, col).Value = arr(i)
         [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
      [COLOR=darkblue]Next[/COLOR] i
      [COLOR=darkblue]Set[/COLOR] rng = rng.Offset(1, 0)
   [COLOR=darkblue]Loop[/COLOR]
 
   [COLOR=darkblue]Set[/COLOR] rng = [COLOR=darkblue]Nothing[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]

 

[tudorr]

Bertie,
Your solution is magic for me.
Thank you so much and please receive my best regards.

Tudor