excel VB regexp 5.5 capturing group - regex

I have a problem using regexp in excel macro, by calling regex.execute(string), instead of getting an array of returned capturing groups, I always get single return which is the whole string specified in the pattern.
By using the same pattern in http://www.regexr.com/, I can see the return nicely grouped. What am I missing from this:
Private Sub ParseFileName(strInput As String)
Dim regEx As New RegExp
Dim strPattern As String
Dim strReplace
'Sample string \\Work_DIR\FTP\Results\RevA\FTP_01_01_06_Results\4F\ACC2X2R33371_SASSSD_run1
strPattern = "FTP_(\w+)_Results\\(\w+)\\([\d,\D]+)_(SAS|SATA)(HDD|SSD)_run(\d)"
With regEx
.Global = True
.MultiLine = False
.IgnoreCase = False
.Pattern = strPattern
End With
If regEx.Test(strInput) Then
Set strReplace = regEx.Execute(strInput)
ActiveCell.Offset(0, 1) = strReplace.Count
Else
ActiveCell.Offset(0, 1) = "(Not matched)"
End If
End sub
In the end, strReplace.Count always shows 1, which is the whole string FTP_01_01_06_Results\4F\ACC2X8R133371_SASSSD_run1

Use .SubMatches to get capturing groups values:
Private Sub ParseFileName(strInput As String)
Dim regEx As New RegExp
Dim strPattern As String
Dim strReplace As MatchCollection
Dim i As Long
'Sample string \\Work_DIR\FTP\Results\RevA\FTP_01_01_06_Results\4F\ACC2X2R33371_SASSSD_run1
strPattern = "FTP_(\w+)_Results\\(\w+)\\([\d,\D]+)_(SAS|SATA)(HDD|SSD)_run(\d)"
With regEx
.Global = True
.MultiLine = False
.IgnoreCase = False
.Pattern = strPattern
End With
If regEx.Test(strInput) Then
Set strReplace = regEx.Execute(strInput)
ActiveCell.Offset(0, 1) = strReplace.Count
For i = 0 To 5
ActiveCell.Offset(i + 1, 1) = strReplace(0).SubMatches(i)
Next
Else
ActiveCell.Offset(0, 1) = "(Not matched)"
End If
End Sub

Related

Regex - how to test for 2 str patterns and make replacements based on which str pattern matches

I currently have two functioning separate subs in Excel VBA. Each sub searches for a different string pattern and then makes a replacement.
Sub 1 searches for a leading 0 in the target string, strips it out, and places the contents in a separate cell.
Sub 2 searches for terminal "99" in the target string, replacing the "99" with Xs, and places the contents in a separate cell.
The way I do this particular operation is to run Sub1 first. Results are placed in column AO. Then I run Sub2 against the results obtained from Sub1 and place those results in the next adjacent column.
I would like to combine the two subs and run just one time getting the desired results.
Here are examples of the target string in column W that I am applying the regex against:
098765-9876-77
333222-7777-G5
9876-078-99
9867x77A
Sub 1
Sub tom_briggs_test_leading_zero()
'This sub searches for a leading zero in the target string and removes it.
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("w2:w73352")
For Each cell In Myrange
strPattern = "^0(.*)"
If strPattern <> "" Then
strInput = cell.Value
strReplace = "$1"
With regEx
.Global = True
.MultiLine = True
.IgnoreCase = False
.Pattern = strPattern
End With
If regEx.Test(strInput) Then
cell.Offset(0, 18) = regEx.Replace(strInput, strReplace)
Else
cell.Offset(0, 18) = strInput
End If
End If
Next
End Sub
Sub 2
Sub tom_briggs_test_trailing_99()
'This sub searchs for teriminal 99s in the target string and replaces them
'with -XX.
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("AO2:AO73352")
'AO is the column where results from Sub1 have been placed
For Each cell In Myrange
strPattern = "(.*)-99$"
If strPattern <> "" Then
strInput = cell.Value
strReplace = "$1-XX"
With regEx
.Global = True
.MultiLine = True
.IgnoreCase = False
.Pattern = strPattern
End With
If regEx.Test(strInput) Then
cell.Offset(0, 1) = regEx.Replace(strInput, strReplace)
Else
cell.Offset(0, 1) = strInput
End If
End If
Next
End Sub
Thanks for your consideration.
How about this:
Sub tom_briggs_fix_head_and_tail()
'This sub removes a leading zero in the target string and
'replaces trailing 99s in the target string with -XX.
Dim regExHead As New RegExp
Dim strHeadPattern As String
Dim strHeadReplace As String
Dim regExTail As New RegExp
Dim strTailPattern As String
Dim strTailReplace As String
Dim strInput As String
Dim Myrange As Range
Dim c As Range
Set Myrange = ActiveSheet.Range("w2:w73352")
strHeadPattern = "^0(.*)"
strHeadReplace = "$1"
strTailPattern = "(.*)-99$"
strTailReplace = "$1-XX"
With regExHead
.Global = True
.MultiLine = True
.IgnoreCase = False
.Pattern = strHeadPattern
End With
With regExTail
.Global = True
.MultiLine = True
.IgnoreCase = False
.Pattern = strTailPattern
End With
For Each c In Myrange
strInput = c.Value
strInput = IIf(regExHead.Test(strInput), _
regExHead.Replace(strInput, strHeadReplace), strInput)
strInput = IIf(regExTail.Test(strInput), _
regExTail.Replace(strInput, strTailReplace), strInput)
c.Offset(0, 19) = strInput
Next
End Sub
Hope that helps
You don't need a regex for that. Just take a hint from the following code:
Sub test()
Set myRange = Sheet1.Range("A1:A2") 'Change this range as per your requirement
For Each cell In myRange
strInput = cell.Value
'Checking if the 1st number is 0 or not
If CInt(Mid(strInput, 1, 1)) = 0 Then
strInput = Mid(strInput, 2)
End If
'Checking if -99 is present in the end or not
If StrComp("-99", Right(strInput, 3), 1) = 0 Then
strInput = Left(strInput, Len(strInput) - 3) & "-XX"
End If
'If there was a leading 0 or a trailing 99, then only write the updated value in another cell
If StrComp(cell.Value, strInput, 1) <> 0 Then
cell.Offset(0, 1).Value = strInput
End If
Next
End Sub

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
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
If its always 3 digits then use \s\d{3} https://regex101.com/r/lEc4mN/1
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

RegEx to extract first set of digits from a string

I am trying to extract the first set of digits only with regex function from col A in Vba.
PRECEDEX 200 mcg 2 mL FTV should print only 200. Currently my code prints all the numbers.
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("E3:E1500")
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
You should just use \d+ pattern, and use .Execute rather than .Replace method to actually extract the digits (you also need to use RegExp.Global=False to find only the first match).
Use
Sub splitUpRegexPattern()
Dim Regex As New regexp
Dim strPattern As String
Dim strInput As String
Dim Myrange As Range
Dim mtch As Object
Set Myrange = ActiveSheet.Range("E3:E1500")
For Each c In Myrange
strPattern = "\d+"
If strPattern <> "" Then
strInput = c.Value
With Regex
.Global = False
.MultiLine = True
.IgnoreCase = False
.pattern = strPattern
End With
If Regex.test(strInput) Then
Set mtch = Regex.Execute(strInput)
If mtch.Count > 0 Then
c.Offset(0, 1) = mtch.Item(0).Value
End If
Else
c.Offset(0, 1) = "(Not matched)"
End If
End If
Next
End Sub
Here, Set mtch = Regex.Execute(strInput) tries to find the match and if a match is found (If mtch.Count > 0), the value (mtch.Item(0).Value) is added to the next column on the right.

How to return a matchCollection from function in Visual Basic, Excel

I'm trying to return a matchCollection from a function to be able to loop through my matches and write them to excel cells outside the function.
I get the run-time error 91: Object variable or With block variable not set, when my code comes to:
If matches1.Count <> 0 Then
This is my code:
Sub simpleRegex()
Dim ShortRange As range
Set ShortRange = ActiveSheet.range("A2:A505")
Dim strInput1 As String
Dim matches1 As MatchCollection
For Each cell In ShortRange
strInput1 = cell.Value
Set matches1 = CheckMatch(strInput1)
If matches1.Count <> 0 Then
cell(1, 3).Value = matches1(0).SubMatches(2)
cell(1, 4).Value = matches1(0).SubMatches(3)
End If
Next
End Sub
Public Function CheckMatch(str As String) As MatchCollection
Dim strPattern1 As String
Dim strInput As String
Dim regEx As New RegExp
Dim matches As MatchCollection
Dim Match As Boolean
Match = False
strPattern1 = "((storlek|strl|stl|strlk|storleken|storl|size|storleksmärkt|storl|storlk|st).{0,2}?(?:[^\s]+)?.{0,2}?)?(30|32|34|36|38|40|42|44|46|48|50).?(30|32|34|36|38|40|42|44|46|48|50)?"
strInput = str
With regEx
.Global = True
.MultiLine = False
.IgnoreCase = True
.Pattern = strPattern1
End With
If regEx.test(strInput) Then
Match = True
Set matches = regEx.Execute(strInput)
End If
Set CheckMatch = matches
End Function
Anyone who knows how this can be fixed?

Combine RegEx and fill an underminate number of cells

I have a cell in Excel that holds a long string in cell A1:
"ABC12+BED58,YZ001"
I have the following regex to match some specific variables in my string
strPattern = "[A-Z]{1,3}[0-9]{2,4}"
Basically, I need to write a macro or a function (I would prefer a function actually) that will fill cell A2, A3, A4 like that:
ABC12
BED58
YZ001
The thing is, there is an undeterminate number of parameters in the string (so for example, it could go all the way through A200).
I'm thinking of a function get_n_variables(str, n) that would return the Nth unique match
Here is my progress so far but the function returns #VALUE!
Function simpleCellRegex(Myrange As Range) As String
Dim regEx As New RegExp
Dim strPattern As String
Dim strInput As String
Dim matches As Object
strPattern = "[A-Z]{1,3}[0-9]{2,4}"
If strPattern <> "" Then
strInput = Myrange.Value
strReplace = ""
With regEx
.Global = True
.MultiLine = True
.IgnoreCase = False
.Pattern = strPattern
End With
If regEx.Test(strInput) Then
Set matches = regEx.Execute(strInput)
simpleCellRegex = matches(0).SubMatches(0)
Else
simpleCellRegex = "Not matched"
End If
End If
End Function
From MrExcel Forum:
You can not put a function in a cell to change other cells. Functions do not work this way.
Thus, it should be a sub, like this, e.g. (outputs the matches under the selected cell with our input string):
Sub simpleCellRegex()
Dim regEx As New RegExp
Dim strPattern As String
Dim strInput As String
Dim matches As MatchCollection
Dim i As Long, cnt As Long
strPattern = "[A-Z]{1,3}[0-9]{2,4}"
cnt = 1
If strPattern <> "" Then
strInput = ActiveCell.Value
strReplace = ""
With regEx
.Global = True
.MultiLine = True
.IgnoreCase = False
.Pattern = strPattern
End With
If regEx.test(strInput) Then
Set objMatches = regEx.Execute(strInput)
For i = 0 To objMatches.Count - 1
ActiveCell.Offset(cnt).Value = objMatches.Item(i)
cnt = cnt + 1
Next
End If
End If
End Sub
Output:
You can actually still use an function if you use an array
select B1:D1
enter this formula =simpleCellRegex(A1) and press CTRL+SHIFT+ENTER
if you dont know how many matches enter in more cells than there may be matches
code
Function simpleCellRegex(StrIn As String) As Variant
Dim regEx As Object
Dim regMC As Object
Dim X
Dim strPattern As String
Dim lngCnt As Long
strPattern = "[A-Z]{1,3}[0-9]{2,4}"
Set regEx = CreateObject("vbscript.regexp")
With regEx
.Global = True
.MultiLine = True
.IgnoreCase = False
.Pattern = strPattern
If .Test(StrIn) Then
Set regMC = .Execute(StrIn)
ReDim X(0 To regMC.Count - 1) As String
For lngCnt = 0 To UBound(X)
X(lngCnt) = regMC(lngCnt)
Next
simpleCellRegex = X
Else
simpleCellRegex = "Not matched"
End If
End With
End Function