CODEWITHSUNDEEP
regexvbaexcel
MC12
MC12

Reputation: 93

Regex to extract numbers from a String in VBA

How can I extract the numbers from col A and print in into col B.

I am using the below regex function, it print all the numbers with a space between them.

How can I get the initial set of numbers and skip the remaining ones.

Docetaxel Injection 160MG/16ML prints 160 16. I need to print only 160. 

Private Sub splitUpRegexPattern()
    Dim regEx As New RegExp
    Dim strPattern As String
    Dim strInput As String
    Dim strReplace As String
    Dim Myrange As Range

    Set Myrange = ActiveSheet.Range("A1:A10")

    For Each C In Myrange
        strPattern = "\D+"

        If strPattern <> "" Then
            strInput = C.Value
            strReplace = "$1"

            With regEx
                .Global = True
                .MultiLine = True
                .IgnoreCase = False
                .Pattern = strPattern
            End With

            If regEx.test(strInput) Then
                C.Offset(0, 1) = regEx.Replace(strInput, " ")
            Else
                C.Offset(0, 1) = "(Not matched)"
            End If
        End If
    Next
End Sub

Upvotes: 2

Views: 6165

Answers (2)

0m3r
0m3r

Reputation: 12499

If its always 3 digits then use \s\d{3} https://regex101.com/r/lEc4mN/1

enter image description here

Option Explicit
Private Sub splitUpRegexPattern()
    Dim regEx As New RegExp
    Dim strPattern As String
    Dim strInput As String
    Dim strReplace As String
    Dim Myrange As Range
    Dim C As Range
    Dim Matches As Variant

    Set Myrange = ActiveSheet.Range("A1:A10")

    For Each C In Myrange
        strPattern = "\s\d{3}"

        If strPattern <> "" Then
            With regEx
                .Global = True
                .MultiLine = True
                .IgnoreCase = False
                .Pattern = strPattern
                 Set Matches = .Execute(C.Value)
            End With

            If Matches.Count > 0 Then
                Debug.Print Matches(0)
                C.Offset(0, 1) = Matches(0)
            Else
                C.Offset(0, 1) = "(Not matched)"
                Debug.Print "Not Found "
            End If

        End If
    Next
End Sub

Upvotes: 1

Tim Williams
Tim Williams

Reputation: 166331

This should work (pattern allows for decimals but not very robustly so):

Sub splitUpRegexPattern()

    Dim re As Object, c As Range
    Dim allMatches

    Set re = CreateObject("VBScript.RegExp")
    re.Pattern = "([\d+\.]+)"
    re.IgnoreCase = True
    re.Global = True

    For Each c In ActiveSheet.Range("A1:A10").Cells
        Set allMatches = re.Execute(c.Value)
        If allMatches.Count > 0 Then
            c.Offset(0, 1).Value = allMatches(0)
        Else
            c.Offset(0, 1).Value = "(Not matched)"
        End If
    Next c

End Sub

Upvotes: 2

Related Questions