REGEX on Range of cells

[gallen]

Hello,

I'm not new VBA but fairly green on regex.

An example of the cells is:

1004006088 ProductName 3.0MM 2X20LM

I need to find the "MM" and then all numeric characters to the left including the period. However sometimes the text may have an space between the numerics and the "MM" so I need to allow for this too

1004006088 ProductName 3.0 MM 2X20LM

Ultimately I need to extract the 3.0MM or 3.0 MM ONLY.

Reading a few tutorials has just ended up me getting more confused.

Any help would be appreciated

 

[wideboydixon]

Try this as your regular expression:

([0-9.]+)\s?MM

The first capture group should then contain the number you're looking for. You can test it out here:

https://regex101.com/

WBD

 

[wideboydixon]

Sorry - misread your post I think. You can remove the capture group to just get the match:

[0-9.]+\s?MM

WBD

 

[gallen]

Thank you for replying WBD. I will give it a go and let you know how I get on. Cheers

 

[gallen]

Thank you. The match works perfectly. However I now need to store the match in a string variable.

I've tried Regex.Replace but I end up with the matched string being deleted from the original string.

How do I delete all but the matched string? I've just done a quick search and can't seem to get the answer

 

[gallen]

Here is how my test set up looks (Columns A B & C)

Strings to Test	Pattern to find	Results
1 2.5mn 20x2LM	([0-9.]+)\s?MM	3 2.5 20x2LM
2 2.5xmm 20x2LMn		4 2.5 20x2LM
3 2.5mm 20x2LM		5 2.5 20x2LM
4 2.5mm 20x2LM		6 2.5 20x2LM
5 2.5mm 20x2LM		7 2.5 20x2LM
6 2.5mm 20x2LM		8 2.5 20x2LM
7 2.5mm 20x2LM		10 2.5 20x2LM
8 2.5mm 20x2LM		11 2.5 20x2LM
9 2.5 mm 20x2LM		12 2.5 20x2LM
10 2.5mm 20x2LM		13 2.5 20x2LM
11 2.5mm 20x2LM
12 2.5mm 20x2LM
13 2.5mm 20x2LM

<tbody>
</tbody>

And here is my code:

Sub ExtractData()
'Test sub to loop through all string values in Column A (from row 2 onwards) and put the results of the tested regex in column C
Dim regEx
Dim c As Range, lr As Long
Dim nr As Long 'next row
Dim i As Long
Dim pattern As String
Set regEx = CreateObject("VBScript.RegExp")
regEx.IgnoreCase = True
regEx.Global = True
regEx.pattern = [B2] 'Cell with pattern


    'next empty row for results
    nr = 2
    lr = Range("A" & Rows.Count).End(xlUp).Row
    
    'clear previous results
    Range("C2:C" & Range("C" & Rows.Count).End(xlUp).Row).Clear
    
    'loop through all strings in colA and put results in colC
    For Each c In Range("A2:A" & lr)
        If (regEx.Test(c)) Then
            Cells(nr, 3) = regEx.Replace(c, "")
            nr = nr + 1
        End If
    Next


End Sub

How do I get it to extract the string and place it in the results?

 

[wideboydixon]

Execute method will return a MatchCollection. You can then iterate over the collection and fetch the Value of each Match:

Public Sub test()

Dim regEx As Object
Dim matches As Object
Dim match As Object

Set regEx = CreateObject("VBScript.RegExp")

With regEx
    .Global = True
    .Pattern = "[0-9.]+\s?MM"
    Set matches = .Execute("1004006088 ProductName 3.0MM 2X20LM")
End With

If matches.Count > 0 Then
    For Each match In matches
        Debug.Print match.Value
    Next match
End If

End Sub

WBD

 

[wideboydixon]

Sub ExtractData()
'Test sub to loop through all string values in Column A (from row 2 onwards) and put the results of the tested regex in column C
Dim regEx
Dim c As Range, lr As Long
Dim nr As Long 'next row
Dim i As Long
Dim pattern As String
Set regEx = CreateObject("VBScript.RegExp")
regEx.IgnoreCase = True
regEx.Global = True
regEx.pattern = [B2] 'Cell with pattern

    'next empty row for results
    nr = 2
    lr = Range("A" & Rows.Count).End(xlUp).Row
    
    'clear previous results
    Range("C2:C" & Range("C" & Rows.Count).End(xlUp).Row).Clear
    
    'loop through all strings in colA and put results in colC
    For Each c In Range("A2:A" & lr)
        If (regEx.test(c)) Then
            Cells(nr, 3) = regEx.Execute(c.Value).Item(0).Value
            nr = nr + 1
        End If
    Next

End Sub

 

[gallen]

On the money.

Superb. Thank you

 

[Rick Rothstein]

Just in case you are interested, here is a non-RegExp macro that should also work for you...

[table="width: 500"]
[tr]
	[td]Sub ExtractData()
  Dim R As Long, X As Long, Parts() As String, Data As Variant, Result As Variant
  Data = Range("A2", Cells(Rows.Count, "A").End(xlUp))
  ReDim Result(1 To UBound(Data), 1 To 1)
  For R = 1 To UBound(Data)
    Parts = Split(Data(R, 1), "mm", , vbTextCompare)
    If Not Parts(0) Like "*[!0-9. ]*" And Not Parts(0) Like "* " Then
      X = X + 1
      Result(X, 1) = Join(Parts)
    End If
  Next
  Range("C2").Resize(UBound(Result)) = Result
End Sub[/td]
[/tr]
[/table]