Getting wildcards to work in find and replace function in VBA macro for Microsoft Word

Question

Hello all!

Thanks in advance for your help!

I have a VBA macro for Microsoft Word that I am trying to improve.

The purpose of the macro is to bold and italicize all words in a document that match the search terms in the first table of the document.

The problem is the search terms include wildcards which are the following:

the hyphen "-": between letters a wildcard for either a space or a period

asterisk "&": (the site is not letting me put in asterisks as this is the markdown for italicize, so I'll put in the & symbol instead to get around the filters) a wildcard for any number of characters at the beginning of a word or at the end. Unlike normal programming languages though, when it is used in the middle of the word it needs to be combined with the hyphen to be a wildcard for a range of characters. For example "th&-e" would pick up "there" while "th&e" would not.

question mark "?": wildcard for a single character

What I am doing so far is just testing for these characters and if they are present I either lop them off in the case of the asterisk, or I alert the user that they have to search for the word manually. Not ideal :-P

I have tried the .MatchWildcard property in VBA but have not yet gotten it to work. I have a feeling it has something to do with the replacement text, not the search text.

A working macro will take the following as its input (the first row is intentionally ignored and the second column is the one with the target search terms):

Imagine this in a table all in the second column (as the html allowed here doesn't allow tr and td etc)

First row: Word
Second row: Search
Third row: &earch1
Fourth row: Search2&
Fifth row: S-earch3
Sixth row: S?arch4
Seventh row: S&-ch5

And it will search the document and replace with bold and italicized content like so:

Search Search1 Search2 Search3 Search4 Search5

Note: S-earch3 could also pick up S.earch3 and replace with Search3

As one might assume the search terms will usually not be right next to each other - the macro should find all instances.

I will include my attempted but nonfunctional code as well after the first working macro.

The code for the working macro will be on pastebin for a month from today, which is 9/17/09, at the following url:

http://pastebin.com/m7ee9165f

Thanks again for any thoughts and help you might have to offer!

Sara

Working VBA Macro:

Sub AllBold()

Dim tblOne As Table

Dim celTable As Cell

Dim rngTable As Range

Dim intCount As Integer

Dim celColl As Cells

Dim i As Integer

Dim rngLen As Integer

Dim bolWild As Boolean

Dim strWild As String


Set tblOne = ActiveDocument.Tables(1)

intCount = tblOne.Columns(2).Cells.Count

Set celColl = tblOne.Columns(2).Cells

strWild = ""

For i = 1 To intCount

    If i = 1 Then

    i = i + 1

    End If

    Set celTable = ActiveDocument.Tables(1).Cell(Row:=i, Column:=2)

    Set rngTable = ActiveDocument.Range(Start:=celTable.Range.Start, _
        End:=celTable.Range.End - 1)

    rngLen = Len(rngTable.Text)

    bolWild = False

    If (Mid(rngTable.Text, rngLen, 1) = "&") Then 'remember to replace & with asterisk!'

    rngTable.SetRange Start:=rngTable.Start, End:=rngTable.End - 1

    End If

    If (Mid(rngTable.Text, 1, 1) = "&") Then 'remember to replace & with asterisk!'

    rngTable.SetRange Start:=rngTable.Start + 1, End:=rngTable.End

    End If

    If InStr(1, rngTable.Text, "-", vbTextCompare) > 0 Then

    strWild = strWild + rngTable.Text + Chr$(13)

    bolWild = True

    End If

    If InStr(1, rngTable.Text, "?", vbTextCompare) > 0 Then

    strWild = strWild + rngTable.Text + Chr$(13)

    bolWild = True

    End If

    If (bolWild = False) Then

        Dim oRng As Word.Range

            Set oRng = ActiveDocument.Range

            With oRng.Find

            .ClearFormatting

            .Text = rngTable.Text

            With .Replacement

            .Text = rngTable.Text

            .Font.Bold = True

            .Font.Italic = True

            End With

            .Execute Replace:=wdReplaceAll

    End With

    End If

Next

If bolWild = True Then

MsgBox ("Please search the following strings with - or ? manually:" + Chr$(13) + strWild)

End If

End Sub

Attempted Nonfunctional VBA Macro:

Sub AllBoldWildcard()

Dim tblOne As Table

Dim celTable As Cell

Dim rngTable As Range

Dim intCount As Integer

Dim celColl As Cells

Dim i As Integer

Dim rngLen As Integer

Dim bolWild As Boolean

Dim strWild As String

Dim strWildcard As String


Set tblOne = ActiveDocument.Tables(1)

intCount = tblOne.Columns(2).Cells.Count

Set celColl = tblOne.Columns(2).Cells

strWild = ""

For i = 1 To intCount

    If i = 1 Then

    i = i + 1

    End If

    Set celTable = ActiveDocument.Tables(1).Cell(Row:=i, Column:=2)

    Set rngTable = ActiveDocument.Range(Start:=celTable.Range.Start, _
        End:=celTable.Range.End - 1)

    rngLen = Len(rngTable.Text)

    bolWild = False

    If (Mid(rngTable.Text, 1, 1) = "&") Then 'remember to replace & with asterisk!'

    rngTable.SetRange Start:=rngTable.Start + 1, End:=rngTable.End

    End If

    If InStr(1, rngTable.Text, "&", vbTextCompare) > 0 Then 'remember to replace & with asterisk!'

    strWildcard = rngTable.Text

    rngTable.Text = Replace(rngTable.Text, "&", "", 1) 'remember to replace & with asterisk!'

    bolWild = True

    End If

    If InStr(1, rngTable.Text, "-", vbTextCompare) > 0 Then

    strWildcard = Replace(rngTable.Text, "-", "[.-]", 1)

    bolWild = True

    End If

    If InStr(1, rngTable.Text, "?", vbTextCompare) > 0 Then

    strWild = strWild + rngTable.Text + Chr$(13)

    strWildcard = Replace(rngTable.Text, "?", "_", 1)


    bolWild = True

    End If

    If (bolWild = False) Then

        Dim oRng As Word.Range

            Set oRng = ActiveDocument.Range

            With oRng.Find

            .ClearFormatting

            .Text = strWildcard

            .MatchAllWordForms = False

            .MatchSoundsLike = False

            .MatchFuzzy = False

            .MatchWildcards = True


            With .Replacement

            .Text = rngTable.Text

            .Font.Bold = True

            .Font.Italic = True

            End With

            .Execute Replace:=wdReplaceAll

    End With

    End If

Next

'    If bolWild = True Then'

'    MsgBox ("Please search the following strings with - or ? manually:" + Chr$(13) + strWild)'

'    End If'

End Sub

Answer 1

Maybe the LIKE statement could help you:

if "My House" like "* House" then

end if

Regular Expressions: Searching for Search4 and replace it by SEARCH4 and using wildcards to achieve that:

Set objRegEx = CreateObject("vbscript.regexp")
objRegEx.Global = True
objRegEx.IgnoreCase = True
objRegEx.MultiLine = True 

'here you can enter your search with wild cards
'mine says "S" followed by any character followed by "arch" followed by 1-n numbers.
objRegEx.Pattern = "S.arch([0-9]+)"


newText = objRegEx.Replace("Test Search4", "SEARCH$1")
MsgBox (newText) 
'gives you: Test SEARCH4

More information how those wildcards to use can be found here It might be hard in the beginning but I promise you will love it ;)

You can replace use to search for strings too:

Dim text As String text = "Hello Search4 search3 sAarch2 search0 search"

Set objRegEx = CreateObject("vbscript.regexp")
objRegEx.Global = True
objRegEx.IgnoreCase = True
objRegEx.MultiLine = True

'here you can enter your search with wild cards
'mine says "S" followed by any character followed by "arch" followed by 1-n numbers.
objRegEx.Pattern = "S.arch[0-9]+"


If (objRegEx.test(text) = True) Then
    Dim objMatch As Variant
    Set objMatch = objRegEx.Execute(text)   ' Execute search.

    Dim wordStart As Long
    Dim wordEnd As Long
    Dim intIndex As Integer
    For intIndex = 0 To objMatch.Count - 1
        wordStart = objMatch(intIndex).FirstIndex
        wordEnd = wordStart + Len(objMatch(intIndex))

        MsgBox ("found " & objMatch(intIndex) & " position: " & wordStart & " - " & wordEnd)
    Next
End If

The result for the variable text would be:

Search4 position: 6 - 13
Search3 position: 14- 21
...

So in your code you would use

rngTable.Text as text

and

rngTable.SetRange Start:=rngTable.Start + wordStart, End:=rngTable.Start + wordEnd

would be the range you want to set bold.

Answer 2

Sub AllBold()

Dim tblOne As Table

Dim celTable As Cell

Dim rngTable As Range

Dim intCount As Integer

Dim intMatch As Integer

Dim celColl As Cells

Dim i As Integer

Dim strRegex As String

Dim Match, Matches


Set tblOne = ActiveDocument.Tables(1)

intCount = tblOne.Columns(2).Cells.Count

Set celColl = tblOne.Columns(2).Cells

Set objRegEx = CreateObject("vbscript.regexp")
objRegEx.Global = True
objRegEx.IgnoreCase = True
objRegEx.MultiLine = True

For i = 1 To intCount

    If i = 1 Then

    i = i + 1

    End If

    Set celTable = ActiveDocument.Tables(1).Cell(Row:=i, Column:=2)

    Set rngTable = ActiveDocument.Range(Start:=celTable.Range.Start, _
        End:=celTable.Range.End - 1)

    If rngTable.Text <> "" Then
        strRegex = rngTable.Text

        strRegex = Replace(strRegex, "*-", "[\w]{0,}[^\w]{0,1}[\w]{0,}", 1)

        strRegex = Replace(strRegex, "*", "\w+", 1)

        strRegex = Replace(strRegex, "-", "[^\w]{0,1}", 1)

        strRegex = Replace(strRegex, "?", ".", 1)

        objRegEx.Pattern = "\b" + strRegex + "\b"

        Dim oRng As Word.Range

        Set oRng = ActiveDocument.Range

        Set Matches = objRegEx.Execute(ActiveDocument.Range.Text)

        intMatch = Matches.Count

        If intMatch >= 1 Then

        rngTable.Bold = True

        For Each Match In Matches

            With oRng.Find

            .ClearFormatting

            .Text = Match.Value

            With .Replacement

            .Text = Match.Value

            .Font.Bold = True

            .Font.Italic = True

            End With

            .Execute Replace:=wdReplaceAll

            End With

        Next Match

        End If

    End If
Next i

End Sub