Highlight phrases from a phrase list in another Word or Excel document

Question

I found the macro in this link and it works great, https://wordribbon.tips.net/T001173_Highlight_Words_from_a_Word_List.html:

It highlights words from another Word document in the current document. I need to see if it can work for phrases and not just single words. It's okay if I need to put identifying markers before and after the phase, like double brackets or something [[ ... ]], for example. Is this possible and how would it be placed in this macro?

If the list could be from an Excel document, that would be even better but not a deal breaker.

Examples are: Tony the Tiger (but only when the macro finds that entire phrase. As it works now, it would find all instances of all three words independently and the 'the' would of course be problematic. Another one would be '17th c.' In this case, it finds every c and every dot as well. It would be ideal to find only the entire phrase.

score 0 · Answer 1 · answered Apr 09 '21 at 22:15

The code in the link you posted is very inefficient. For a way more efficient approach, see:

https://www.msofficeforums.com/word-vba/23196-need-help-creating-macro.html

A simple solution that doesn't require another file is:

Sub BulkHighlighter()
Application.ScreenUpdating = False
Dim i As Long, StrFnd As String, HiLt As Long
HiLt = Options.DefaultHighlightColorIndex
Options.DefaultHighlightColorIndex = wdBrightGreen
StrFnd = InputBox("Insert your 'Find' terms with | delimiters, for example:" & vbCr & "the quick brown fox|jumped over|the lazy dog")
With ActiveDocument.Range.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .MatchWholeWord = True
  .MatchCase = False
  .Replacement.Highlight = True
  .Replacement.Text = "^&"
  For i = 0 To UBound(Split(StrFnd, "|"))
    .Text = Split(StrFnd, "|")(i)
    .Execute Replace:=wdReplaceAll
  Next
End With
Options.DefaultHighlightColorIndex = HiLt
Application.ScreenUpdating = True
End Sub

Alternatively, if the list of strings to be highlighted is fixed:

Sub BulkHighlighter() Application.ScreenUpdating = False Dim i As Long, StrFnd As String, HiLt As Long HiLt = Options.DefaultHighlightColorIndex Options.DefaultHighlightColorIndex = wdBrightGreen StrFnd = "the quick brown fox|jumped over|the lazy dog" With ActiveDocument.Range.Find .ClearFormatting .Replacement.ClearFormatting .MatchWholeWord = True .MatchCase = False .Replacement.Highlight = True .Replacement.Text = "^&" For i = 0 To UBound(Split(StrFnd, "|")) .Text = Split(StrFnd, "|")(i) .Execute Replace:=wdReplaceAll Next End With Options.DefaultHighlightColorIndex = HiLt Application.ScreenUpdating = True End Sub

If you're wedded to using an Excel file, try:

Sub BulkHighlighter()
Application.ScreenUpdating = False
Dim xlApp As Object, xlWkBk As Object, StrWkBkNm As String
Dim StrWkSht As String, xlFList As String, i As Long

'Identify the WorkBook and WorkSheet
StrWkBkNm = "C:\Users\" & Environ("Username") & "\Documents\BulkFindReplace.xlsx"
StrWkSht = "Sheet1"

On Error Resume Next
'Start Excel
Set xlApp = CreateObject("Excel.Application")
If xlApp Is Nothing Then
  MsgBox "Can't start Excel.", vbExclamation
  Exit Sub
End If
On Error GoTo 0
With xlApp
  'Hide our Excel session
  .Visible = False
  ' The file is available, so open it.
  Set xlWkBk = .Workbooks.Open(StrWkBkNm, False, True)
  If xlWkBk Is Nothing Then
    MsgBox "Cannot open:" & vbCr & StrWkBkNm, vbExclamation
    .Quit: Set xlApp = Nothing: Exit Sub
  End If
  ' Process the workbook.
  With xlWkBk
    With .Worksheets(StrWkSht)
      ' Capture the F/R data.
      For i = 1 To .Cells(.Rows.Count, 1).End(-4162).Row ' -4162 = xlUp
        ' Skip over empty fields to preserve the underlying cell contents.
        If Trim(.Range("A" & i)) <> vbNullString Then
          xlFList = xlFList & "|" & Trim(.Range("A" & i))
        End If
      Next
    End With
  .Close False
  End With
  .Quit
End With
' Release Excel object memory
Set xlWkBk = Nothing: Set xlApp = Nothing
'Exit if there are no data
If xlFList = "" Then Exit Sub
'Process each word from the F/R List
With ActiveDocument.Range.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .MatchWholeWord = True
  .MatchCase = True
  .Wrap = wdFindContinue
  .Replacement.Text = "^&"
  For i = 1 To UBound(Split(xlFList, "|"))
    .Text = Split(xlFList, "|")(i)
    .Execute Replace:=wdReplaceAll
  Next
End With
Application.ScreenUpdating = True
End Sub

For processing multiple documents in the same folder using an Excel workbook, see:

https://www.msofficeforums.com/70404-post4.html

Note that the code in this last link shows how to process content in headers, footers, etc. also.

Highlight phrases from a phrase list in another Word or Excel document

1 Answers1