Friday, May 16, 2008

VBA/VB6/VBS word replace - Regular expressions

Did you ever wish you could replace entire words within a string? Maybe you're changing names within a document and want to change "Mark" to "Horace", but don't want to have "market" turn into "Horaceet". Or maybe you want to insert a word, but only in relation to another specific word? Then use regular expressions!

Make sure to escape any regexp special characters, and use the \b word boundaries around the 'Find what' portion. Occasionally I'll even use my "rxPatt = ..." line in other routines when I need to escape a search string for regexp. Works well, though I find myself using this less and less nowadays. Unless you have long strings within cells, it isn't that useful for Excel unfortunately. I have found a couple uses here and there, but not too many.

Anyways.. on to the code!

Function RegExWordReplace(ByVal rxFull As String, ByVal rxWhat As String, ByVal _
rxRepl As String, Optional ByVal rxIgnoreCase As Boolean = True) As String
'rxFull = Full string that you will be doing your find/replace within
'rxWhat = What to find within the full string
'rxRepl = What to replace the found string with
'rxIgnoreCase = You can make the search case-sensitive by specifying this = false
Dim RegEx As Object, rxPatt As String
Set RegEx = CreateObject("vbscript.regexp")
rxPatt = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
Replace(Replace(Replace(Replace(rxWhat, "\", "\\"), "^", "\^"), "$", "\$"), "*", _
"\*"), "+", "\+"), "?", "\?"), ".", "\."), "(", "\("), ")", "\)"), "|", "\|"), _
"{", "\{"), "}", "\}"), ",", "\,")
With RegEx
.Pattern = "\b" & rxPatt & "\b"
.Global = True
.IgnoreCase = rxIgnoreCase
.MultiLine = True
End With
If RegEx.Test(rxFull) Then rxFull = RegEx.Replace(rxFull, rxRepl)
RegExWordReplace = rxFull
Set RegEx = Nothing
End Function

And to test it:
Sub WordReplaceExample()
Dim OrigStr As String, NewStr As String
OrigStr = "Our normal products were found to have no side effects."
NewStr = RegExWordReplace(OrigStr, "no", "no adverse")
MsgBox OrigStr & vbCrLf & vbCrLf & NewStr
End Sub

No comments: