Bold Term Macro that DOES NOT bold terms with Quotation Marks

[NotOriginal]

Long time lurker, first time poster. I have a macro for MS Word that searches/bolds 115 terms, however, I need the macro to avoid bolding terms that are in quotations. For example, I have the word closing in bold, but if it is displayed as "closing" then I want that term to be ignored. Is there a way to do this?



A sample of my code is below:

Sub BoldPolicyWords()

Dim wordsToBold(1 To 3) As String
wordsToBold(1) = "word 1"
wordsToBold(2) = "word 2"
wordsToBold(3) = "word 3"


For i = 1 To 3

With Selection.Find
.Text = wordsToBold(i)
.Replacement.Text = "" ' Replace with empty string (optional)
.Replacement.Font.Bold = True
.Forward = True
.Wrap = wdFindContinue
.MatchWholeWord = True
End With

Selection.Find.Execute Replace:=wdReplaceAll
Next i

End Sub

[vivka]

Hi, former lurker, current poster ! If the words to bold are flanked by spaces, I think, the solution is quite simple:

wordsToBold(1) = " word 1 "
wordsToBold(2) = " word 2 "
wordsToBold(3) = " word 3 "

or:

wordsToBold(1) = "word 1 "
wordsToBold(2) = "word 2 "
wordsToBold(3) = "word 3 "

If the codes above meet your needs, I will not propose a more complicated solution.

[gmaxey]

Sometimes I find it easier to just bold all the undo the spec cases.


Since there is good chance some of the words may start a sentence or end a sentence the space suggestions Vivka makes may not work.

Sub BoldPolicyWords()
Dim wordsToBold() As String
Dim lngIndex As Long
Dim oRng As Range
wordsToBold = Split("Word1,Word2,Word3", ",")
  For lngIndex = 0 To UBound(wordsToBold)
    Set oRng = ActiveDocument.Range
    With oRng.Find
     .Text = wordsToBold(lngIndex)
     .Replacement.Font.Bold = True
     .Forward = True
     .Wrap = wdFindStop
     .MatchWholeWord = True
     .Execute Replace:=wdReplaceAll
    End With
    Set oRng = ActiveDocument.Range
    With oRng.Find
     .Text = "[^0147^34]" & wordsToBold(lngIndex) & "[^0148^34]"
     .Replacement.Font.Bold = False
     .Forward = True
     .Wrap = wdFindStop
     .MatchWildcards = True
     .MatchWholeWord = True
     Do While .Execute
       With oRng
        .MoveEnd Unit:=wdCharacter, Count:=-1
        .MoveStart Unit:=wdCharacter, Count:=1
        .Font.Bold = False
        .Collapse wdCollapseEnd
       End With
     Loop
    End With
  Next lngIndex
End Sub