How to extract numbers from a text string in VBA [duplicate] - vba

Question

This question already has answers here:
Excel UDF for capturing numbers within characters
(4 answers)
Closed 4 years ago.
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

Answer 1

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

Answer 2

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

Answer 3

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: