Extract numbers from a string

ChristineJ

ChristineJ

Well-known Member
Joined
May 18, 2009
Messages
771
Office Version
  1. 365
Platform
  1. Windows
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
 

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".
Sort by date Sort by votes
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,
 
Upvote 0
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
 
Upvote 0
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,
Click to expand...
Thank you so much for the reply. I will test it out.
 
Upvote 0
Rick Rothstein said:
Are you going to also test the code I posted as well?
Click to expand...
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
 
Upvote 0
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
 
Upvote 0
Solution
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
Click to expand...
Fair enough! I guess I didn't know exactly what to ask for. Thanks again for the help with this. Much appreciated. CJ
 
Upvote 0
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
ABCDEFG
1-5-1 Cash10858 YYY6758 YYYY6715629.6
2
3Peter56, 775, 12, 1085858, 674.6, 5, 6
4Rick56, 775, 12, 10858584.6, 5, 6
Sheet1
Cell Formulas
RangeFormula
B1B1=A1-5
C1C1=A1+6-B2-7&" Cash"
D1D1=(SUM(D16:D18)-H219-75)/(D20*12)*DATEDIF(C15,G21,"m")+108
E1E1="58 YYY67"
F1F1="58 YYYY67"
G1G1=4.6+A1+5^6
B3:G3B3=GetNums(B1)
B4:G4B4=ExtractNumber(B1)
 
Last edited:
Upvote 0
If B1 has a formula with absolute addresses like this: =$B$20+2
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Solved
Extract 8 character number from text string
2
Replies
15
Views
742
Fluff
Fluff
V
  • Solved
Extracting numbers from a string and adding them up
2
Replies
19
Views
1K
Vector8086
V
A
  • Question Question
Matching a number sequence within a group of numbers in a cell
Replies
1
Views
542
FormR
FormR
K
  • Question Question
Auto Sort (Descinding) based on a column header using VBA
Replies
1
Views
253
Fluff
Fluff
D
  • Question Question
Scoring weighted permutations
Replies
1
Views
219
StephenCrump
S

Forum statistics

Threads
1,223,903
Messages
6,175,289
Members
452,631
Latest member
a_potato

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top