Macro to Find & Highlight Words from List

DRD992 · #1 06-20-2021, 08:53 AM

I need to create a macro that finds and highlights many (>100) selected words in a MS Word 2013 document. Those searched for words are listed in a single column table, locate in a separate file. I would like to have the selected document words highlighted in yellow. My OS is Windows 7.

I have failed multiple times to create the above macro. I tried adapting code used by others for similar tasks, to no avail. I was going to display the code I tried, but somehow it was deleted when MS Word locked up. Frustrating.

I could use some help.

Thank you.

macropod · #2 06-20-2021, 04:50 PM

For example:

Code:

Sub BulkHiliter()
Application.ScreenUpdating = False
Dim FRDoc As Document, FRList, i As Long
 'Load the strings from the reference doc into a text string to be used as an array.
Set FRDoc = Documents.Open("Drive:\FilePath\FindReplaceList.doc", ReadOnly:=True, Addtorecentfiles:=False, Visible:=False)
FRList = FRDoc.Range.Text: FRDoc.Close False: Set FRDoc = Nothing
With ActiveDocument.Range.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .MatchWholeWord = True
  .MatchCase = True
  .Replacement.Text = "^&"
  .Replacement.Highlight = True
  'Process each word from the List
  For i = 0 To UBound(Split(FRList, vbCr)) - 1
    .Text = Split(FRList, vbCr)(i)
    .Execute Replace:=wdReplaceAll
  Next
End With
Application.ScreenUpdating = True
End Sub

The above code assumes the source list is not in a table, but is just a list separated by paragraph breaks.

DRD992 · #3 06-21-2021, 07:42 AM

Macropod,

Thank you for all your help!

When I try to run the macro, it stops, with the following:

Run-time error "91":

Object variable or With block variable not set

What should I do?

I appreciate all your help.

DRD992

macropod · #4 06-21-2021, 02:21 PM

That suggests you haven't changed the:
"Drive:\FilePath\FindReplaceList.doc"
to point to your own document.

DRD992 · #5 06-21-2021, 03:13 PM

Macropod,

Thank you for your patience and help!

The macro doesn't lock up, thanks to your trouble shooting. Making progress!

But it doesn't highlight the selected words. Correct me if I'm wrong, but I don't see the code for applying a yellow highlight. Could that be my problem?

Thank you putting up with me!

DRD992

macropod · #6 06-21-2021, 08:59 PM

That will be because you haven't already chosen a highlight colour from the highlight options. To force the use of a particular highlight In this case yellow), you could insert:
Options.DefaultHighlightColorIndex = wdYellow
after:
Application.ScreenUpdating = False

DRD992 · #7 06-22-2021, 04:25 AM

Macropod,

Success! Thank you for all your help!

I have a question.

I would like to add the following line of code to the macro, if it doesn't cause problems:

.MatchALLWordForms = True

Is that OK? If so, where should it go?

Thank you!!

DRD992

macropod · #8 06-22-2021, 03:26 PM

You could add
.MatchAllWordForms = True
between
.MatchCase = True
and
.Replacement.Text = "^&"

DRD992 · #9 06-23-2021, 04:44 AM

Thank you, Macropod!

Themillen · #10 02-25-2023, 09:16 AM

I used the macro below you provided in this chat and it works, thanks! However, would it be possible to limit it to the text I selected in the active document only? The seperate document has 2000 words, so if the active document has too mucht text it will ages... Even though I might only want to scan like 100 words to be highlighted. If anyone can help, much appreciated!

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

macropod · #11 02-25-2023, 02:08 PM

After:

.Replacement.Highlight = True

Insert:

.Wrap = wdFindStop

Cross-posted at: vba - Change word macro to scan selected text only (to save time in large documents) - Stack Overflow
For cross-posting etiquette, please read: A message to forum cross posters - Excelguru

Themillen · #12 03-02-2023, 12:55 AM

Thanks for rosponding so quickly! If you don't mind I would like to ask one more thing about this though. Because I just tested this macro as follows: first I had 1 word-file with only one paragraph of text in it, then I selected it and ran the macro. Then I went to another document that has a lot of text in it, but I still selected the exact same text as before.

For some reason, the second run took waaaay longer, which gives me the feeling that it is still also scanning al the other text. Could that be? And if so, would you know how to fix that?

Guessed · #13 03-02-2023, 05:48 PM

The selection range changes as soon as you find an instance so the loop will start from that new selection location and if that location is collapsed then that is where you start from and .Wrap isn't set in your code.

How much content is in the FRDoc file? This seems pretty inefficient to need to retrieve the search terms from there. Can you store that as a building block so it can be retrieved faster?

Themillen · #14 03-02-2023, 11:10 PM

Quote:

Originally Posted by Guessed

The selection range changes as soon as you find an instance so the loop will start from that new selection location and if that location is collapsed then that is where you start from and .Wrap isn't set in your code.

How much content is in the FRDoc file? This seems pretty inefficient to need to retrieve the search terms from there. Can you store that as a building block so it can be retrieved faster?

As an English teacher, I thought it would be interesting to highlight all C1-level words in students' texts. However, this means the document contains about 2000 words... If possible, I would even like to make it larger. But perhaps I could still include these words in my macro as multiple arrays?

Anyways, thanks for responding, hope I'm not making things too difficult now

Guessed · #15 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

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
highlight words not in list	karkey	Word VBA	3	01-05-2021 02:13 PM
Macro To Identify & Highlight Words In MS Word Based Upon A List In Excel File Column	abhimanyu	Word VBA	5	03-20-2020 01:33 PM
How to find (highlight) two and more words in a list of 75k single words in Word 2010	Usora	Word	8	05-29-2018 03:34 AM
Macro to highlight a list of words	bakerkr	Word VBA	4	10-19-2017 02:23 PM
Find and highlight all words ending in -ly	RBLampert	Word VBA	13	10-23-2012 04:45 PM