VBA Extract Numbers only from Cell and Insert spaces Inbetween (Getnumbers)

Hi All,

I have been given the below bit of VBA from a friend to extract the numbers only from a cell (which works fine) but it extracts all the numbers and puts them all together without and spaces or delimiter which is a bit of a problem as i need to put each number that i extract into seperate cells (I was planning on doing this with text to coulms once i had them extracted)

Function GetNumbers(cText As String)
Dim Lenc As Integer
Dim x As Integer
Lenc = Len(cText)
x = 1
Do While x < Lenc
If IsNumeric(Mid(cText, x, 1)) Then
GetNumbers = GetNumbers & Mid(cText, x, 1)
End If
x = x + 1
Loop
End Function

Can any one help with this?

Many thanks

Jamie

I have been given this by my friend but i have no idea how to link it all together

Getnumbers is a good start.

I would have a look at split instead of looping through the string for the.

e.g.
This will split the cell content into small chunks delimited by the space, not tested but should work:

for i = 0 to len(ctext) - len(replace(ctext," "))
    test=split(ctext," ")(i)
    if isnumeric(test) then
        if split(ctext," ")(i-1) <> "Class" then
             GetNumbers = Getnumbers & test & " "
        endif
    end if
next
getnumbers = trim(getnumbers)

You can then repeat the above but use instr in order to find the location of each number.

e.g.

instr(split(getnumbers)(i),ctext,1,1)

this will give you the numeric position of the number from which you can then do some string manipulation.

newstring = left(oldstring,location_of_number-2) & "class " & mid(oldstring,location_of_number,2) & vcbcrlf & mid(oldstring,location_of_number+2)

That should hopefully be enough to get you started

try
=GetAllNumbers(A1,", ")

Function GetAllNumbers(ByVal txt As String, delim As String) As String
    Dim m As Object
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = "(-?\d+(\.\d+)?)"
        For Each m In .Execute(txt)
            GetAllNumbers = GetAllNumbers & delim & m.Value
        Next
    End With
    GetAllNumbers = Mid$(GetAllNumbers, Len(delim) + 1)
End Function