Extract numbers from a string

ChristineJ · Mar 21, 2021

Is there a way to return only the numbers in a formula (excluding numbers that are part of cell references), with a comma after each?

=A1-5 would return 5,
=A1+6-B2-7&" Cash" would return 6,7,
=(SUM(D15:D17)-F218-75)/(D19*12)*DATEDIF(C14,E20,"m")+108 would return 75,12,108

Rino702 · Mar 21, 2021

Here the code for function ExtractNumber

VBA Code:

Option Explicit

Function ExtractNumber(str As String) As String
Dim p As Long, c As String, out As String
    ExtractNumber = ""
    If Len(str) = 0 Then Exit Function
    p = 1
    Do
        c = Mid(str, p, 1)
        If InStr(":=(),;+-/*&%", c) > 0 Then
            p = p + 1
        ElseIf c = """" Then
            Call SkipQuoteString(str, p)
        ElseIf UCase(c) >= "A" And UCase(c) <= "Z" Then
            Call SkipAlphanumeric(str, p)
        ElseIf IsNumeric(c) Then
            out = out & GetNumeric(str, p) & ","
        Else
            MsgBox ("Bad characters '" & c & "' at position " & p & " of string " & str)
            Exit Function
        End If
    Loop Until p > Len(str)
    ExtractNumber = out
End Function

Sub SkipQuoteString(ByRef str As String, ByRef p As Long)
Dim c As String
    Do
        p = p + 1
    Loop Until p > Len(str) Or Mid(str, p, 1) = """"
    If Mid(str, p, 1) = """" Then p = p + 1
End Sub

Sub SkipAlphanumeric(ByRef str As String, ByRef p As Long)
    Do
        p = p + 1
    Loop Until (p > Len(str)) Or Not AlphaNumeric(Mid(str, p, 1))
End Sub

Function GetNumeric(ByRef str As String, ByRef p As Long) As String
Dim b As Long
    b = p
    Do
        p = p + 1
    Loop Until p > Len(str) Or Not IsNumeric(Mid(str, p, 1))
    GetNumeric = Mid(str, b, p - b)
End Function

Function AlphaNumeric(ByVal x As String) As Boolean
    AlphaNumeric = False
    If x >= "A" And x <= "Z" Then AlphaNumeric = True
    If x >= "a" And x <= "z" Then AlphaNumeric = True
    If x >= "0" And x <= "9" Then AlphaNumeric = True
End Function

Sub Test_ExtractNumber()
Dim t As String
    t = ExtractNumber("=A1-5")
    t = ExtractNumber("=A1+6-B2-7&"" Cash""")
    t = ExtractNumber("=(SUM(D15:D17)-F218-75)/(D19*12)*DATEDIF(C14,E20,""m"")+108")
End Sub

Regards,

Rick Rothstein · Mar 21, 2021

Here is a much more compact way to write an ExtractNumber function (all that is needed is the code below... no other Subs or Functions are required)...

VBA Code:

Function ExtractNumber(ByVal Formula As String) As String
  Dim X As Long, Arr As Variant
  For X = 1 To Len(Formula)
    If Mid(Formula, X, 1) Like "[!0-9A-Z.]" Then Mid(Formula, X) = " "
  Next
  Arr = Split(Application.Trim(Formula))
  For X = 0 To UBound(Arr)
    If Arr(X) Like "*[!0-9.]*" Or Arr(X) Like "*.*.*" Then Arr(X) = ""
  Next
  ExtractNumber = Replace(Application.Trim(Join(Arr)), " ", ", ")
End Function

ChristineJ · Mar 21, 2021

Rino702 said:

Here the code for function ExtractNumber

VBA Code:

Option Explicit

Function ExtractNumber(str As String) As String
Dim p As Long, c As String, out As String
    ExtractNumber = ""
    If Len(str) = 0 Then Exit Function
    p = 1
    Do
        c = Mid(str, p, 1)
        If InStr(":=(),;+-/*&%", c) > 0 Then
            p = p + 1
        ElseIf c = """" Then
            Call SkipQuoteString(str, p)
        ElseIf UCase(c) >= "A" And UCase(c) <= "Z" Then
            Call SkipAlphanumeric(str, p)
        ElseIf IsNumeric(c) Then
            out = out & GetNumeric(str, p) & ","
        Else
            MsgBox ("Bad characters '" & c & "' at position " & p & " of string " & str)
            Exit Function
        End If
    Loop Until p > Len(str)
    ExtractNumber = out
End Function

Sub SkipQuoteString(ByRef str As String, ByRef p As Long)
Dim c As String
    Do
        p = p + 1
    Loop Until p > Len(str) Or Mid(str, p, 1) = """"
    If Mid(str, p, 1) = """" Then p = p + 1
End Sub

Sub SkipAlphanumeric(ByRef str As String, ByRef p As Long)
    Do
        p = p + 1
    Loop Until (p > Len(str)) Or Not AlphaNumeric(Mid(str, p, 1))
End Sub

Function GetNumeric(ByRef str As String, ByRef p As Long) As String
Dim b As Long
    b = p
    Do
        p = p + 1
    Loop Until p > Len(str) Or Not IsNumeric(Mid(str, p, 1))
    GetNumeric = Mid(str, b, p - b)
End Function

Function AlphaNumeric(ByVal x As String) As Boolean
    AlphaNumeric = False
    If x >= "A" And x <= "Z" Then AlphaNumeric = True
    If x >= "a" And x <= "z" Then AlphaNumeric = True
    If x >= "0" And x <= "9" Then AlphaNumeric = True
End Function

Sub Test_ExtractNumber()
Dim t As String
    t = ExtractNumber("=A1-5")
    t = ExtractNumber("=A1+6-B2-7&"" Cash""")
    t = ExtractNumber("=(SUM(D15:D17)-F218-75)/(D19*12)*DATEDIF(C14,E20,""m"")+108")
End Sub

Regards,

Thank you so much for the reply. I will test it out.

Rick Rothstein · Mar 21, 2021

Are you going to also test the code I posted as well?

ChristineJ · Mar 21, 2021

Rick Rothstein said:
Are you going to also test the code I posted as well?

Yes, absolutely! Have been working with it and got a bit confused. I saw you had posted a reply a couple of hours ago and I copied and tested your code. It worked great!

When I came back to let you know and to check the "Mark as solution" button beside your post, it was gone. Thought I was dreaming for a minute. About 20 minutes after that I saw you posted again with slightly different code.

The first version of the function you posted works perfectly. The second version returns the one numerical value that is the result of the formula in the cell as if it is a cell reference

Here is the original version. Works fine - do I need to tweak anything?

Thanks so much! If you repost it I can mark it as the solution.

VBA Code:

Function ExtractNumber(Cell As Range) As String
  Dim x As Long, Txt As String, Arr As Variant
  Txt = Cell.Formula
  For x = 1 To Len(Txt)
    If Mid(Txt, x, 1) Like "[!0-9A-Z.]" Then Mid(Txt, x) = " "
  Next
  Arr = Split(Application.Trim(Txt))
  For x = 0 To UBound(Arr)
    If Arr(x) Like "*[!0-9.]*" Or Arr(x) Like "*.*.*" Then Arr(x) = ""
  Next
  ExtractNumber = Replace(Application.Trim(Join(Arr)), " ", ", ")
End Function

Rick Rothstein · Mar 21, 2021

The problem was I did not know how you planned to use the function... whether you wanted to give it a range or the formula as text. Here my original code back again...

VBA Code:

Function ExtractNumber(Cell As Range) As String
  Dim x As Long, Txt As String, Arr As Variant
  Txt = Cell.Formula
  For x = 1 To Len(Txt)
    If Mid(Txt, x, 1) Like "[!0-9A-Z.]" Then Mid(Txt, x) = " "
  Next
  Arr = Split(Application.Trim(Txt))
  For x = 0 To UBound(Arr)
    If Arr(x) Like "*[!0-9.]*" Or Arr(x) Like "*.*.*" Then Arr(x) = ""
  Next
  ExtractNumber = Replace(Application.Trim(Join(Arr)), " ", ", ")
End Function

ChristineJ · Mar 21, 2021

Rick Rothstein said:
The problem was I did not know how you planned to use the function... whether you wanted to give it a range or the formula as text. Here my original code back again...

VBA Code:

Function ExtractNumber(Cell As Range) As String Dim x As Long, Txt As String, Arr As Variant Txt = Cell.Formula For x = 1 To Len(Txt) If Mid(Txt, x, 1) Like "[!0-9A-Z.]" Then Mid(Txt, x) = " " Next Arr = Split(Application.Trim(Txt)) For x = 0 To UBound(Arr) If Arr(x) Like "*[!0-9.]*" Or Arr(x) Like "*.*.*" Then Arr(x) = "" Next ExtractNumber = Replace(Application.Trim(Join(Arr)), " ", ", ") End Function

Fair enough! I guess I didn't know exactly what to ask for. Thanks again for the help with this. Much appreciated. CJ

Peter_SSs · Mar 21, 2021

Here is another option to consider.
You will note that both my function and Rick's fail for column E but mine works for column F. Mine fails where there are exactly 3 upper case letters before the number and those upper case letters would refer to columns beyond the right bound of a worksheet. That is 'columns' XFE to ZZZ.
There would be a few other circumstances where my function would fail but I would expect they are obscure enough to not likely turn up in your formulas - which is also the likely case with my examples in columns E & F below. ?

VBA Code:

Function GetNums(c As Range) As String
  With CreateObject("VBScript.RegExp")
    .Global = True
    .Pattern = "([^A-Z]\$?[A-Z]{1,3}\$?[0-9]{1,7})"
    GetNums = .Replace(c.Formula, "x")
    .Pattern = "[^\d\.]"
    GetNums = Replace(Application.Trim(.Replace(GetNums, " ")), " ", ", ")
  End With
End Function

ChristineJ.xlsm

A

B

C

D

E

F

G

1

2

3

Peter

4

Rick

Sheet1

Cell Formulas
Range	Formula
B1	B1	=A1-5
C1	C1	=A1+6-B2-7&" Cash"
D1	D1	=(SUM(D16:D18)-H219-75)/(D2012)DATEDIF(C15,G21,"m")+108
E1	E1	="58 YYY67"
F1	F1	="58 YYYY67"
G1	G1	=4.6+A1+5^6
B3:G3	B3	=GetNums(B1)
B4:G4	B4	=ExtractNumber(B1)

Phuoc · Mar 21, 2021

If B1 has a formula with absolute addresses like this: =$B$20+2

Extract numbers from a string

ChristineJ

Well-known Member

Excel Facts

Rino702

New Member

Rick Rothstein

MrExcel MVP

ChristineJ

Well-known Member

Rick Rothstein

MrExcel MVP

ChristineJ

Well-known Member

Rick Rothstein

MrExcel MVP

ChristineJ

Well-known Member

Peter_SSs

MrExcel MVP, Moderator

Phuoc

Well-known Member

Similar threads

Forum statistics

Share this page

Extract numbers from a string

Well-known Member

Excel Facts

New Member

MrExcel MVP

Well-known Member

MrExcel MVP

Well-known Member

MrExcel MVP

Well-known Member

MrExcel MVP, Moderator

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock