|
|
Thread Tools | Display Modes |
#1
|
|||
|
|||
How to highlight text in a Word document using a word list from another document
Hello.
I have a MS Word document that I need to check against a table of terms contained in another MS Word document. Essentially, I need to highlight the phrases/words in the document that coincide with phrases/words contained in the table of terms. The table of terms is formatted like this: duplicate line item duplicate procedures duplication of benefits Durable Medical Equipment (DME) durable medical equipment exceeds rental cost durable medical equipment maximum frequency As a first attempt, I tried the code below. The problem is that it highlights EVERY SINGLE WORD from the table of terms. As I explained, I only want to highlight the phrases/words that coincide exactly with the phrases/words from the table (although many of the entries are single words, as a matter of fact). I tried to modify the code but didn’t have any luck. Thanks in advance for whatever help/guidance you can give me. Code:
Sub CompareWordList() Dim sCheckDoc As String Dim docRef As Document Dim docCurrent As Document Dim wrdRef As Object sCheckDoc = "c:\checklist.doc" Set docCurrent = Selection.Document Set docRef = Documents.Open(sCheckDoc) docCurrent.Activate With Selection.Find .ClearFormatting .Replacement.ClearFormatting .Replacement.Highlight = True .Replacement.Text = "^&" .Forward = True .Format = True .MatchCase = True .MatchWildcards = False End With For Each wrdRef In docRef.Words If Asc(Left(wrdRef, 1)) > 32 Then With Selection.Find .MatchWholeWord = True .Wrap = wdFindContinue .Text = wrdRef .Execute Replace:=wdReplaceAll End With End If Next wrdRef docRef.Close docCurrent.Activate End Sub |
#2
|
||||
|
||||
There have been numerous threads in this forum discussing the kind of thing you want, complete with solutions. Try a search.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#3
|
|||
|
|||
Thank you, I'll try.
|
#4
|
|||
|
|||
Hello, Macropod.
Thank you for your advice. Through some search and trial and error I was able to do what I aimed: Highlight words and, specially, full phrases I wanted to identify in my text. I have now another problem: Next to each term that has been identified and highlighted I need to add, in hidden text, a small (glossary like) explanation of that highlighted term. I start with a table that in the first column contains the terms that are going to be identified and highlighted. The second column contains the glossary-like explanation of the terms contained in the first column. I’m struggling to produce a feasible code. Would you have any recommendation and/or advice on how to proceed? I greatly appreciate beforehand any help you can offer me. (These are really my first attempts into VBA programming and, after some considerable search, I haven't found any thread addressing this matter.) |
#5
|
||||
|
||||
You could use Word's 'comment' tool to add the explanatory text. For example:
Code:
Sub Demo() Application.ScreenUpdating = False Dim FRDoc As Document, strFnd As String, strRep As String, i As Long Set FRDoc = Documents.Open("Drive:\FilePath\FindTableData.doc", _ ReadOnly:=True, AddToRecentFiles:=False, Visible:=False) For i = 1 To FRDoc.Tables(1).Rows.Count strFnd = Split(FRDoc.Tables(1).Cell(i, 1).Range.Text, vbCr)(0) strRep = Split(FRDoc.Tables(1).Cell(i, 2).Range.Text, vbCr)(0) With ActiveDocument.Range With .Find .ClearFormatting .Replacement.ClearFormatting .Format = False .MatchCase = True .MatchWholeWord = True .MatchWildcards = False .Wrap = wdFindStop .Text = strFnd .Execute End With Do While .Find.Found .HighlightColorIndex = wdBrightGreen .Comments.Add .Duplicate, strRep .Collapse wdCollapseEnd .Find.Execute Loop End With Next Application.ScreenUpdating = True End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#6
|
|||
|
|||
Thank you very much, macropod!
You are truly a master! I do appreciate your beautiful, elegant solution. Thank you for taking the time to address my question! I applied your code to one of my texts and it works like a charm. However, there is a little problem I’m trying to resolve applying the same idea you suggested (using Comments for the explanatory text): My table of terms is rather large (about 4300 rows) and running the code takes a long time –more than 6 or 7 minutes for a small text (2 pages) that I’m using for testing. The code below, which I used to only highlight the matching terms, took 20 seconds or so for the same text. Would adding the comments add that much time? Once again, macropod, thank you very much for your help! PS. Seeing your code really gives me the motivation and inspiration to learn VBA in depth. (Any recommendation for a text or handbook I could use?) Code:
Sub Finder() Dim sCheckDoc As String Dim docRef As Document Dim docCurrent As Document Dim wrdRef As String Dim wrdPara As Paragraph sCheckDoc = "c:\FilePath\Glossary.docx" Set docCurrent = Selection.Document Set docRef = Documents.Open(sCheckDoc) docCurrent.Activate With Selection.Find .ClearFormatting .Replacement.ClearFormatting .Replacement.Highlight = True .Replacement.Text = "^&" .Forward = True .Format = True .MatchWholeWord = False .MatchCase = False .MatchWildcards = False End With For Each wrdPara In docRef.Paragraphs wrdRef = wrdPara.Range.Text wrdRef = Left(wrdRef, Len(wrdRef) - 1) If Asc(Left(wrdRef, 1)) > 32 Then With Selection.Find .MatchWholeWord = True .MatchCase = False .MatchSoundsLike = False .Wrap = wdFindContinue .Text = wrdRef .Execute Replace:=wdReplaceAll End With End If Next wrdPara docRef.Close docCurrent.Activate End Sub |
#7
|
||||
|
||||
Adding comments and retrieving the contents of a second column from the table will both slow down the code's execution. The main reason for the slower execution is that the Find/Replace can't be done as a single operation using wdReplaceAll when adding comments; instead each found instance must be individually processed.
A possible workaround would be to add the comments to the text in the table (i.e. using only one column), which you would also highlight, then let the macro copy each cell's content to the clipboard and use for the replacement, thus: Code:
Sub Demo() Application.ScreenUpdating = False Dim FRDoc As Document, strFnd As String, RngFnd As Range, i As Long Set FRDoc = Documents.Open("C:\FilePath\Glossary.docx", _ ReadOnly:=True, AddToRecentFiles:=False, Visible:=False) With ActiveDocument.Range.Find .ClearFormatting .Replacement.ClearFormatting .Format = True .Replacement.Text = "^c" .MatchCase = True .MatchWholeWord = True .MatchWildcards = False .Wrap = wdFindContinue For i = 1 To FRDoc.Tables(1).Rows.Count Set RngFnd = FRDoc.Tables(1).Cell(i, 1).Range With RngFnd .End = .End - 1 .Copy strFnd = .Text End With .Text = strFnd .Execute Replace:=wdReplaceAll Next End With Application.ScreenUpdating = True End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#8
|
|||
|
|||
Thank you so much, macropod!
I'm so grateful for your help. As always, your solution is elegant. Just for future reference, I would like to mention a little problem I had with this part of the code: Code:
Set RngFnd = FRDoc.Tables(1).Cell(i, 1).Range With RngFnd .End = .End - 1 .Copy strFnd = .Text End With .Text = strFnd Code:
Set RngFind = GlossaryDoc.Tables(1).Cell(i, 1).Range With RngFind .Copy .End = .End - 2 strFind = .Text End With .Text = strFind Once again, Paul (macropod), thank you so very much for all of your help. |
#9
|
||||
|
||||
Changing:
.End = .End - 1 to: .End = .End - 2 indicates you have some extraneous content between the 'find' expression and the end-of-cell marker. A space or paragraph break, perhaps? As for: Quote:
Quote:
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#10
|
|||
|
|||
Thanks again for explaining and clarifying.
|
Thread Tools | |
Display Modes | |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Find and highlight multiple words in MS Word document | AtaLoss | Word VBA | 37 | 09-22-2021 12:04 PM |
Linking one word document to a 'master' word document - even if files are in private drive | mb3344 | Word | 2 | 08-06-2016 07:10 PM |
Adding tables to Created word document whilst other word document open Help | rpb925 | Word VBA | 18 | 03-30-2016 04:45 PM |
Word document with Macros with trusted locatin versus Word document 1997-2003 | Cardinal2 | Word | 1 | 11-30-2015 07:42 PM |
Can Word highlight the same text in the Reviewing Pane as in the main document? | wordistheword | Word | 4 | 09-09-2013 04:50 AM |