How to extract numbers from a text string in VBA

Question

I need to extract the numbers from a string of text and I'm not quite sure how to do it. The code I've attached below is very preliminary and most likely can be done more elegantly. A sample of the string I'm trying to parse is as follows:

"ID CSys ID Set ID Set Value Set Title 7026..Plate Top MajorPrn Stress 7027..Plate Top MinorPrn Stress 7033..Plate Top VonMises Stress"

I need to pull the numbers 7026, 7027, and 7033. The string will vary in length and the number of values that I'll need to pull will also vary. Any help would be much appreciated. Thanks!

Dim WrdArray() As String
Dim txtstrm As TextStream
Dim line As String
Dim clm As Long
Dim Rw As Long

'------------------------------------------------------------

Dim i As Long

Dim strPath As String
Dim strLine As String
Dim count, count1 As Integer
Dim holder As String
Dim smallSample As String

count = 0
count1 = 1
holder = ""

'Remove Filters and Add Custom Filters
Call Application.FileDialog(msoFileDialogOpen).Filters.Clear
Call Application.FileDialog(msoFileDialogOpen).Filters.Add("Text Files", "*.txt")
Call Application.FileDialog(msoFileDialogOpen).Filters.Add("Dat Files", "*.dat")

'only allow the user to select one file
Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False

'make the file dialog visible to the user
intChoice = Application.FileDialog(msoFileDialogOpen).Show

'determine what choice the user made
If intChoice <> 0 Then

'get the file path selected by the user
strPath = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)

End If

'------------------------------------------------------------

If strPath <> "" Then
    Set txtstrm = FSO.OpenTextFile(strPath)
Else
    MsgBox "No file selected.", vbExclamation
    Exit Sub
End If

Rw = 1
Do Until txtstrm.AtEndOfStream
  line = txtstrm.ReadLine
  clm = 1
  WrdArray() = Split(line, " ") 'Change with ; if required

  For Each wrd In WrdArray()
     If Rw = 1 Then
        Do While count <> Len(wrd)
            smallSample = Left(wrd, 1)
            If smallSample = "0" Or smallSample = "1" Or smallSample = "2" Or smallSample = "3" Or smallSample = "4" _
                    Or smallSample = "5" Or smallSample = "6" Or smallSample = "7" Or smallSample = "8" _
                    Or smallSample = "9" Then
                holder = holder & smallSample
            Else
                If holder <> "" Then
                    Cells(count1, 1) = holder
                    count1 = count1 + 1
                End If
                holder = ""
            End If
            wrd = Right(wrd, Len(wrd) - 1)
            clm = clm + 4
            ActiveSheet.Cells(Rw, clm) = holder
        Loop
     Else
        ActiveSheet.Cells(Rw, clm) = wrd
        clm = clm + 1
     End If
  Next wrd
  Rw = Rw + 1
Loop
txtstrm.Close

End Sub

Extracting the numbers is not hard but you state `"number of values"` will vary. What logic will you apply to know which numbers to pull? — Alex P, Jun 22 '18 at 20:08
replace the `.` with spaces. Split on the spaces. Cycle the resultant array and load a new array with the ones that are numeric. Join the final array with `,` as the delimiter. — Scott Craner, Jun 22 '18 at 20:16
I'll need to pull all the numbers that appear in the string. These are FEMAP output vectors which are defined by these indices. I'm trying to create Excel column headings. The columns will then be populated with the appropriate results data. — Mike S, Jun 22 '18 at 20:25
You could be searching for the method posted in an answer for [VBA: Convert Text to Number](https://stackoverflow.com/a/56816011/8740349) ;-) — Top-Master, Jun 29 '19 at 08:06

score 9 · Accepted Answer · answered Jun 22 '18 at 20:19

9

You can use Regular Expressions.

Sub ExtractNumbers()
    Dim str As String, regex As regExp, matches As MatchCollection, match As match

    str = "ID CSys ID Set ID Set Value Set Title 7026..Plate Top MajorPrn Stress 7027..Plate Top MinorPrn Stress 7033..Plate Top VonMises Stress"

    Set regex = New regExp
    regex.Pattern = "\d+"      '~~~> Look for variable length numbers only
    regex.Global = True

    If (regex.Test(str) = True) Then
        Set matches = regex.Execute(str)   '~~~> Execute search

        For Each match In matches
            Debug.Print match.Value '~~~> Prints: 7026, 7027, 7033
        Next
    End If
End Sub

Make sure you reference the VBA regex library:

Open VBA editor
Tools > References...
Check Microsoft VBScript Regular Expression 5.5

answered Jun 22 '18 at 20:19

Alex P

12,249
5
51
70

Huge +1 for regex. Easy to dismiss it in VBA, but very helpful. – Kyle Jun 22 '18 at 20:28
Thanks. `Regex` still feels like magic every time I use it! – Alex P Jun 22 '18 at 20:35
2

I would have used "Late Binding " `CreateObject("VBScript.RegExp")` for a plug and play answer. Nice post +1 – TinMan Jun 22 '18 at 20:38
Worked perfect! Thanks! – Mike S Jun 22 '18 at 20:41

Scott Craner · Answer 2 · 2018-06-22T20:29:55.487

2

You can use this function that splits the "words and test for numeric:

Function numfromstring(str As String) As String
Dim strarr() As String
str = Replace(str, ".", " ")
strarr = Split(str)
Dim i As Long
For i = 0 To UBound(strarr)
    If IsNumeric(strarr(i)) Then
        numfromstring = numfromstring & "," & strarr(i)
    End If
Next i

numfromstring = Mid(numfromstring, 2)
End Function

You would call it from the worksheet with a formula:

=numfromstring(A1)

Or from vba like this:

Sub try()
Dim str As String
str = "ID CSys ID Set ID Set Value Set Title 7026..Plate Top MajorPrn Stress 7027..Plate Top MinorPrn Stress 7033..Plate Top VonMises Stress"

Dim out As String
out = numfromstring(str)

Debug.Print out
End Sub

If you have Office 365 Excel you can use this array formula:

=TEXTJOIN(",",TRUE,IF(ISNUMBER(--TRIM(MID(SUBSTITUTE(SUBSTITUTE(A1,"."," ")," ",REPT(" ",99)),(ROW($1:$100)-1)*99+1,99))),TRIM(MID(SUBSTITUTE(SUBSTITUTE(A1,"."," ")," ",REPT(" ",99)),(ROW($1:$100)-1)*99+1,99)),""))

Being an array formula it needs to be confirmed with Ctrl-Shift-Enter instead of Enter when exiting edit mode:

edited Jun 22 '18 at 20:29

answered Jun 22 '18 at 20:24

Scott Craner

148,073
10
49
81

This doesn't work: https://i.imgur.com/rmcgbzB.png – KulaGGin Dec 11 '21 at 14:50
1

The question is generic: "How to extract numbers from a text string in VBA". It's not specific to extract a number from a specific string. And your function is broken: it doesn't pass a simple end-to-end test. And it wouldn't pass most of the unit tests either where strings aren't exactly like OP's string. You named it `numfromstring`, not `numfrommikesstring`. I googled it to quickly help someone with excel, so I didn't have to write it myself from scratch, and what I found it like 5 broken numfromstring functions, until I found a working one. – KulaGGin Dec 11 '21 at 18:05
Answer with actually working function, which passes the tests: https://stackoverflow.com/a/40365789/6693304 – KulaGGin Dec 11 '21 at 18:10

score 2 · Answer 3 · answered Jun 22 '18 at 20:25

To exact numbers in the form you want, try something like:

Sub dural()
    Dim s As String, i As Long, L As Long, c As String, temp As String
    s = [A1]
    L = Len(s)
    temp = ""
    For i = 1 To L
        c = Mid(s, i, 1)
        If c Like "[0-9]" Then
            temp = temp & c
        Else
            temp = temp & " "
        End If
    Next i

    temp = "'" & Application.WorksheetFunction.Trim(temp)
    temp = Replace(temp, " ", ",")

    [B1] = temp
End Sub

How to extract numbers from a text string in VBA

3 Answers3