Passing a regular expression pattern from a routine to an Excel VBA function

Question

I am trying to pass a Regex template function to Excel VBA, but the template seems to be inefficient. I inserted msgbox'es to see what the string looks like and they look fine. Here is the code I'm using.

Sub clean_COP_names() Dim strSheet As String Dim strPatternOrig As String Dim strRow As Integer Dim strCol As Integer Dim UpBound As Range Dim LowBound As Range Dim strUpBoundRow As Integer Dim strUpBoundColumn As Integer Dim strLowBoundRow As Integer Dim strLowBoundColumn As Integer Dim CompareRange As Range Dim c As Variant Dim d As Integer Dim strTest As String strTest = ActiveCell.Value strSheet = "Sheet2" strRow = 2 strCol = 2 strUpBoundRow = 0 strUpBoundColumn = 0 strLowBoundRow = 0 strLowBoundColumn = 0 '/////call ext function SelectColumn strSheet, strRow, strCol, strUpBoundRow, strUpBoundColumn, strLowBoundRow, strLowBoundColumn Set CompareRange = Worksheets(strSheet).Range _ (Cells(strUpBoundRow, strUpBoundColumn), Cells(strLowBoundRow, strLowBoundColumn)) d = 1 Cells(d, 6).Value = "Alumni Officer - Last,First names" strPatternOrig = """^([^ ]+)([ ]+)([^ ]+)([ ]+)([^ ]+)(.*)$""" 'MsgBox (strPatternOrig) For Each c In CompareRange d = d + 1 '/////ext function Cells(d, 6).Value = Reorder_Name_COP_Data_a(c.Value, strPatternOrig, "$3,$1") Next End Sub Function Reorder_Name_COP_Data_a(strData As String, strPattern As String, strReplacementPattern As String) As String Dim RE As Object Set RE = CreateObject("vbscript.regexp") With RE .MultiLine = False '.Global = False .Global = True .IgnoreCase = True 'MsgBox (strPattern) .Pattern = strPattern End With Reorder_Name_COP_Data_a = RE.Replace(strData, strReplacementPattern) End Function 

===================

supplement April 26, 2012 Thank you very much -

I noticed that the problem persists when I use escaped quotes, as shown below:

  strPatternOrig = "^[ ]?([^\ ,()""'']+)(?:[ ](\(([^)]*?)\)))?[ ]((?:(([^\ ,()""''])[^\ ,()""'']*)[ ])([^\ ,()""'']+(?:[ ][^\ ,()""'']+)*))(?: [ ]? , [ ]?(.*?))?[ ]?(\(\s*'*\d*\s*\))[ ]?$" 

Do I need to strip double and single quotes differently? Worked above when the Regex template was “tightly bound” to a function, but when it was passed to a function, it fails. Thanks again.

Answer 1

You do not need to avoid single quotes, only double quotes. Once a variable has been assigned with a string constant, it can be freely moved around and it will not change.

The only real problem that you encounter with a large regex is that it does not match because you left some “air” in it.
This is what you have:

 "^[ ]?([^\ ,()""'']+)(?:[ ](\(([^)]*?)\)))?[ ]((?:(([^\ ,()""''])[^\ ,()""'']*)[ ])([^\ ,()""'']+(?:[ ][^\ ,()""'']+)*))(?: [ ]? , [ ]?(.*?))?[ ]?(\(\s*'*\d*\s*\))[ ]?$" 

This is what should be:

 "^[ ]?([^\ ,()""']+)(?:[ ](\(([^)]*?)\)))?[ ]((?:(([^\ ,()""'])[^\ ,()""']*)[ ])([^\ ,()""']+(?:[ ][^\ ,()""']+)*))(?:[ ]?,[ ]?(.*?))?[ ]?(\(\s*'*\d*\s*\))[ ]?$" 

Here is a test case with your regular expression (which only matches the multi-last form, if I remember):

 Dim RXE As Object Dim RXNorm As Object Sub RegexColumnValueComparison() Dim strData As String Dim strPat As String Call InitializeRXs ' Here, the grad part ('#) is optional strPat = "^[ ]?([^\ ,()""']+)(?:[ ](\(([^)]*?)\)))?[ ]((?:(([^\ ,()""'])[^\ ,()""']*)[ ])([^\ ,()""']+(?:[ ][^\ ,()""']+)*))(?:[ ]?,[ ]?(.*?))?[ ]?(?:(\(\s*'*\d*\s*\))[ ]?)?$" ' Here, the grad part ('#) is required 'strPat = "^[ ]?([^\ ,()""']+)(?:[ ](\(([^)]*?)\)))?[ ]((?:(([^\ ,()""'])[^\ ,()""']*)[ ])([^\ ,()""']+(?:[ ][^\ ,()""']+)*))(?:[ ]?,[ ]?(.*?))?[ ]?(\(\s*'*\d*\s*\))[ ]?)$" strData = " John Bert Smith, Jr ('78) " MsgBox (RxRepl(strData, strPat, "$7 $8 , $1 $3 $6 $9")) End Sub Function RxRepl(sData As String, sPat As String, sRepl As String) As String sData = RXNorm.Replace(sData, " ") RXE.Pattern = sPat ' Can test for pass/fail .. 'If RXE.Test(sData) Then ' MsgBox ("matched pattern") 'Else ' MsgBox ("did NOT match pattern") 'End If RxRepl = RXE.Replace(sData, sRepl) End Function Sub InitializeRXs() Set RXE = CreateObject("vbscript.regexp") Set RXNorm = CreateObject("vbscript.regexp") RXE.Global = True RXNorm.Global = True RXNorm.Pattern = "\s+" End Sub