excelvbanumbersextract# Extracting groups of numbers from a text string and separate into columns

I have found a script that does this task however it seems slow and does not deal with decimal points. I am using a mac and cannot use regular expressions.

Examples of the data set (quite messy)are as follows

```
$2900 + Slab ($550) + P/Prep ($350) + Xover ($500)
$2600 + Pave Prep ($350) + Slab ($550) + Crossover ($500)
$2900 + $350 P/Prep + $500 Xover
2800+Slab$480+PavePrep$315+ Pave Prep$7.00+XOver$450
$3350(inc prep up to 50m2)+Slab$650+Extra P/prep$224+Xover$450
WM02-3050 XO-450 PPEX-128 SS-650
WM01-2850 XO-450 SS-650
XO-450 PPEX-307.68 SS-650 WM03-3350 DRYLINE-0
XO-450 PPEX-126.08 SS-650 WM01-2850
```

Don't need the numbers that are identifier eg. WM01, WM03, 50m2 Happy to remove small numbers <10

Would like the output to be

```
2900 550 350 500
2600 350 550 500
2900 350 500
2800 480 315 7 450
3350 650 224 450
3050 450 128 650
2850 450 650
450 307.68 3350
450 126.08 650 2850
```

I can then use the text to columns function. Thanks

```
Function NDigits(ByVal SourceString As String, _
Optional ByVal NumberOfDigits As Long = 0, _
Optional ByVal TargetDelimiter As String = " ") As String
Dim i As Long ' SourceString Character Counter
Dim strDel As String ' Current Target String
' Check if SourceString is empty (""). Exit if. NDigits = "".
If SourceString = "" Then Exit Function
' Loop through characters of SourceString.
For i = 1 To Len(SourceString)
' Check if current character is not a digit (#), then replace with " ".
If Not Mid(SourceString, i, 1) Like "#" Then _
Mid(SourceString, i, 1) = " "
Next
' Note: While VBA's Trim function removes spaces before and after a string,
' Excel's Trim function additionally removes redundant spaces, i.e.
' doesn't 'allow' more than one space, between words.
' Remove all spaces from SourceString except single spaces between words.
strDel = Application.WorksheetFunction.Trim(SourceString)
' Check if current TargetString is empty (""). Exit if. NDigits = "".
If strDel = "" Then Exit Function
' Replace (Substitute) " " with TargetDelimiter if it is different than
' " " and is not a number (#).
If TargetDelimiter <> " " And Not TargetDelimiter Like "#" Then
strDel = WorksheetFunction.Substitute(strDel, " ", TargetDelimiter)
End If
' Check if NumberOfDigits is greater than 0.
If NumberOfDigits > 0 Then
Dim vnt As Variant ' Number of Digits Array (NOD Array)
Dim k As Long ' NOD Array Element Counter
' Write (Split) Digit Groups from Current Target String to NOD Array.
vnt = Split(strDel, TargetDelimiter)
' Reset NOD Array Element Counter to -1, because NOD Array is 0-based.
k = -1
' Loop through elements (digit groups) of NOD Array.
For i = 0 To UBound(vnt)
' Check if current element has number of characters (digits)
' equal to NumberOfDigits.
If Len(vnt(i)) = NumberOfDigits Then
' Count NOD Array Element i.e. prepare for write.
k = k + 1
' Write i-th element of NOD Array to k-th element.
' Note: Data (Digit Groups) are possibly being overwritten.
vnt(k) = vnt(i)
End If
Next
' Check if no Digit Group of size of NumberOfDigits was found.
' Exit if. NDigits = "".
If k = -1 Then Exit Function
' Resize NOD Array to NOD Array Element Count, possibly smaller,
' due to fewer found Digit Groups with the size of NumberOfDigits.
ReDim Preserve vnt(k)
' Join elements of NOD Array to Current Target String.
strDel = Join(vnt, TargetDelimiter)
End If
' Write Current Target String to NDigits.
NDigits = strDel
End Function
```

Solution

*Note:* The RegExp pattern has been tested against the sample data provided. You might need to fine-tune it to match your specific data set accurately.

```
Option Explicit
Sub GetDigits()
Dim objRegEx As Object, sRes As String
Dim objMH As Object, rngData As Range
Dim arrData, arrRes()
Dim i As Long, j As Integer
' Create RegExp object
Set objRegEx = CreateObject("vbscript.regexp")
objRegEx.Pattern = "(^|[\s\+])\D*(\d+\-)*(\d{2,}(\.\d+)*)(?![A-Z])"
' Case-insensitive
objRegEx.IgnoreCase = True
objRegEx.Global = True
' Load source data
Set rngData = Range("A1", Cells(Rows.Count, "A").End(xlUp))
arrData = rngData.Value
ReDim arrRes(1 To UBound(arrData), 1 To 1)
' Loop through data
For i = LBound(arrData) To UBound(arrData)
sRes = ""
' RegExp matching
Set objMH = objRegEx.Execute(Trim(arrData(i, 1)))
If objMH.Count > 0 Then
' Collect match result
For j = 0 To objMH.Count - 1
sRes = sRes & Chr(32) & objMH(j).submatches(2)
Next
arrRes(i, 1) = Mid(sRes, 2)
End If
Next
' Write output to sheet
With rngData.Offset(0, 1)
.ClearContents
.Value = arrRes
End With
Set objMH = Nothing
Set objRegEx = Nothing
End Sub
```

- Build vertical summary from Columns with Count
- Excel - Create a Unit Conversion sheet - Multiple links
- update cell when column header matches a list
- Delete text in cell subject to Worksheet_Change
- Counting the number of visible rows after autofilter
- Excel 2007: AVERAGEIF, SUMIF, COUNTIF, MAXIF, MINIF across multiple sheets, multple rows
- Import CSV data from a txt file skipping the first line and adding headers
- Simplifying SumIFs formulas for efficient excel formula
- I'd like to find out how to find the current streak of non-negative numbers in a row of data in Excel
- ValueError: Invalid character found in sheet title
- decrypt excel files
- Excel table search funcion that looks for partial string match
- Combine macros to filter on today's and tomorrow's date
- Converting line breaks to commas in excel sheet using Powershell
- Combinations of numbers arranged side by side as many as a random number (VBA)
- How can I remove ONLY leading and trailing spaces while leaving spaces in between words alone with an excel formula?
- VBA Date as integer
- Sliding Window Auto Increment Range
- Count cells with different conditional ranges
- Turning flattened pivots data into tables -Error tables can't overlap - Excel Vba
- How do I get only a specific part of a cell in Excel or Numbers?
- Calculate the Legendre symbol of two integers in Excel
- Unable to get text wrapping or vertical centering to work with xlsxwriter
- Number stored as text warning in excel using POI
- VBA Excel paste to the columns in regular intervals
- Convert filtered values from formulas to values
- Sorting Dictionary by nested class objects data [VBA]
- Events does not appear when making an Outlook query from Excel
- The script works well when I use MSXML2.XMLHTTP.6.0, but it fails miserably when I switch to MSXML2.serverXMLHTTP.6.0
- How to convert text string (d h m s) to time format in excel