Microsoft Office Forums - View Single Post - [Solved] Macro to Find & Highlight Words from List

Guessed · 03-03-2023, 12:22 AM

Ok, for that quantity of Words I would say stick with your current method (unless you save it as a csv text file). The time consuming part of the macro will probably be the loop itself.

Try these modifications

Code:

Sub B2_Highlighter_Selection_andAllWordForms()
  Dim FRDoc As Document, FRList() As String, i As Long, aRng As Range
  Application.ScreenUpdating = False
    Options.DefaultHighlightColorIndex = wdBrightGreen
    Set FRDoc = Documents.Open("C:\path.docx", ReadOnly:=True, Addtorecentfiles:=False, Visible:=False)
    FRList = Split(FRDoc.Range.Text, vbCr)
    FRDoc.Close False
    'FRList = Split("Document True Text ClearFormatting", " ") 'for testing only
    Set FRDoc = Nothing
    Set aRng = Selection.Range
    With aRng.Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .MatchWholeWord = True
      .MatchCase = False
      .Wrap = wdFindStop
      .Replacement.Text = "^&"
      .Replacement.Highlight = True
      For i = 0 To UBound(FRList)   'Process each word from the List
        If Trim(FRList(i)) <> "" Then
          .Text = Trim(FRList(i))
          .Execute Replace:=wdReplaceAll
        End If
      Next
    End With
  Application.ScreenUpdating = True
End Sub