Passing Regex Pattern From Sub to Function in Excel VBA

Question

I'm trying to pass a Regex pattern to a Function in Excel VBA, but the pattern seems to be of none effect. I've inserted msgbox'es to see what the string looks like, and they turn out ok. Here's 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

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

addendum apr 26,2012 Many thanks-

I've noticed that the problem persists when I use escaped quotes as below:

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

Do the double and single quotes need to be escaped in a different way, possibly? The above worked when the Regex pattern was 'hard wired' into the function, but when it's passed to the function, it fails. Thanks again.

I doubt if you really need the extra double quotes on both sides. What happens if you remove them? i.e. strPatternOrig = "^([^ ]+)([ ]+)([^ ]+)([ ]+)([^ ]+)(.*)$" ? — Pradeep Kumar
– Pradeep Kumar, Commented Apr 25, 2012 at 22:31
@Pradeep: You may have just hit the nail on the head! I tested with with other RegEx Strings and the above function worked fine. :) — Siddharth Rout
– Siddharth Rout, Commented Apr 25, 2012 at 22:37
Watch out here: Set CompareRange = Worksheets(strSheet).Range _ (Cells(strUpBoundRow, strUpBoundColumn), Cells(strLowBoundRow, strLowBoundColumn)) You really should qualify the Cells ie use Worksheets(strSheet).Cells(...) or will get unexpected results when a different sheet is active. Same goes for any other use of Cells: always best to qualify them with a worksheet reference. — Tim Williams
– Tim Williams, Commented Apr 26, 2012 at 0:43
Many thanks for your help. Yes, I was able to successfully get it to work without the extra double quotes; however, when I used another pattern (please see my addendum on the orig question) that involved escaped quotes, it failed. — buck1112
– buck1112, Commented Apr 26, 2012 at 21:09

user557597 · Accepted Answer · 2012-05-01 21:22:49Z

You don't need to escape single quotes, only the double quotes. Once the variable has been assigned with a string constant, it can be passed around freely and it will not change.

The only real problem you are having with the big regex is that it is not matching because you left some 'air' in it.
This is what you have:

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

This is what it should be:

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

Here is a test case with your regex (which only matches 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

Collectives™ on Stack Overflow

Passing Regex Pattern From Sub to Function in Excel VBA

1 Answer 1

Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related