|
|
Thread Tools | Display Modes |
#1
|
|||
|
|||
Searching a Word document with multiple words from a list (over 1,000 terms) and BOLD all occurrence
Hi everyone! I use Microsoft 365 for business. I am just learning about macros in Word, and I'm struggling with a problem I'm trying to solve. I have put together a list of 1,129 words and phrases that, if they appear in my weekly Word document, need to be in Bold print. Some of the phrases have commas, and some may have apostrophes. There are definitely quite a few with dashes, and some slashes.
Note: I have the list in an Excel workbook right now. I am trying to create a macro that will draw the list of terms from the excel workbook, search my document for each term and emBolden them as they are found. So far, I've tried the following code. It is a slightly revised copy of an answer I found at stackoverflow for a similar question. They wanted highlighting, I believe, but otherwise it was very similar to my problem. Sub Pre_List_for_Bold() ' Sub Pre_List_for_Bold() Dim xl As Object 'Excel.Application Dim wb As Object 'Excel.Workbook Dim ws As Object 'Excel.Worksheet Dim rng As Object 'Excel.Range Dim cl As Object 'Excel.Range Set xl = CreateObject("Excel.Application") Set wb = xl.Workbooks.Open("C:\biglist.xlsx") '## Modify as needed Set ws = wb.Sheets(1) '##Modify as needed Set rng = ws.Range("B3", ws.Range("B3").End(xlDown)) For Each cl In rng Call EMBOLD_NEC_LIST(cl.Value, cl.Offset(0, 1).Value) Next End Sub Sub EMBOLD_NEC_LIST(findText$, replaceText$) ' ' EMBOLD_NEC_LIST Macro ' ' ' ' Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = findText .Replacement.Text = replaceText .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll Selection.Find.Execute End Sub ' End Sub However, when I run the macro, I get the following error message: Run-time error 1004: Application-defined or object-defined error When I hit debug, it highlights the line I put in Red text above "Set rng = ws.Range("B3", ws.Range("B3").End(xlDown))" I can't see what is wrong with the line, but then again I've only started learning this. If anyone has some ideas, I would be very grateful for the help. Thank you! Last edited by Nicknamednick; 09-27-2022 at 02:32 AM. Reason: adding error message image |
#2
|
||||
|
||||
xlDown is the name of a constant that only has a value to Excel's vba. You loaded the Excel Application as an object (late binding) so your code is unable to use the Excel constants directly. If you replace it with its actual value (-4121) the line of code should work.
Code:
Set rng = ws.Range("B3", ws.Range("B3").End(-4121)) Code:
Sub EMBOLD_NEC_LIST(findText As String, replaceText As String) With ActiveDocument.Range.Find .ClearFormatting .Replacement.ClearFormatting .Text = findText .Replacement.Text = replaceText .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False .Execute Replace:=wdReplaceAll .Text = replaceText .Replacement.Text = "" .Replacement.Font.Bold = True .Execute Replace:=wdReplaceAll End With End Sub
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia Last edited by Guessed; 09-27-2022 at 04:25 PM. |
#3
|
||||
|
||||
For example:
Code:
Sub Demo() Dim xlApp As Object, xlWkBk As Object, StrWkBkNm As String, StrWkSht As String Dim iDataRow As Long, xlFList, i As Long StrWkBkNm = "C:\Users\" & Environ("Username") & "\Documents\WordList.xlsx" StrWkSht = "Sheet1" If Dir(StrWkBkNm) = "" Then MsgBox "Cannot find the designated workbook: " & StrWkBkNm, vbExclamation Exit Sub End If 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(FileName:=StrWkBkNm, ReadOnly:=True, AddToMru:=False) If xlWkBk Is Nothing Then MsgBox "Cannot open:" & vbCr & StrWkBkNm, vbExclamation .Quit Exit Sub End If ' Process the workbook. With xlWkBk 'Ensure the worksheet exists If SheetExists(xlWkBk, StrWkSht) = True Then With .Worksheets(StrWkSht) ' Find the last-used row in column A. iDataRow = .Cells(.Rows.Count, 1).End(-4162).Row ' -4162 = xlUp ' Capture the F/R data. For i = 1 To iDataRow ' 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 Else MsgBox "Cannot find the designated worksheet: " & StrWkSht, vbExclamation End If .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 With ActiveDocument.Range.Find .ClearFormatting .Replacement.ClearFormatting .Replacement.Font.Bold = True .Format = True .Wrap = wdFindContinue 'Process each string from the List For i = 1 To UBound(Split(xlFList, "|")) .Text = Split(xlFList, "|")(i) .Replacement.Text = "^&" .Execute Replace:=wdReplaceAll Next End With Application.ScreenUpdating = True End Sub Function SheetExists(xlWkBk As Object, SheetName As String) As Boolean Dim i As Long: SheetExists = False For i = 1 To xlWkBk.Sheets.Count If xlWkBk.Sheets(i).Name = SheetName Then SheetExists = True: Exit For End If Next End Function
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#4
|
|||
|
|||
Andrew, thank you for those tips! That did clear up the issue with that line. And I made the other changes you suggested as well. However, when I ran the macro again, the original document was left in shambles. Nothing new had been bolded, and there were parts of words missing throughout the document and whole words gone.
Maybe the problem is with my Excel list itself? As I mentioned there are both phrases and words in the list, and some of the phrases have duplicate words from the rest of the list in them. Could the commas within some of the phrases be causing issues? --David |
#5
|
|||
|
|||
Thank you, Macropod for the tips. I just want to make sure my instincts are correct:
Quote:
[I assume, enter my own local path to the .xlsx between the " ". And also, if the workbook I'm using has a sheet called "Table1 (2)" with the word list, I should swap out for "Sheet1"]] ... Quote:
I'll try this code next. Thank you again! --David |
#6
|
||||
|
||||
The list you have is exceptionally important as is the order of proceedings. If you have already replaced a word then it won't be found in any subsequent search. Or if you have replaced a word with a new word, that new word might be a target for a subsequent replacement step.
Test the code with a very short replacement list and pay attention to how earlier replacements will impact the subsequent searches. Also be aware of words within words eg find 'shall' and replace with 'will' makes 'shallow' change to 'willow'. Since you are also searching for phrases you can't just change the MatchWholeWord setting to correct that.
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#7
|
||||
|
||||
Quote:
StrWkBkNm = "C:\Users" & Environ("Username") & "\Documents\WordList.xlsx" to: StrWkBkNm = ActiveDocument.Path & "\WordList.xlsx" Otherwise, you could supply the fill path & filename. Quote:
No, that's just a text comment. Regardless of what you change that to, the code will still look in column A. If you want to search a different column, change the column reference in the .Range("A" & i) references.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#8
|
||||
|
||||
If you're confident it will always be there, you can delete/comment-out the 'If SheetExists(xlWkBk, StrWkSht) = True Then' test:
Code:
'Ensure the worksheet exists ' If SheetExists(xlWkBk, StrWkSht) = True Then With .Worksheets(StrWkSht) ' Find the last-used row in column A. iDataRow = .Cells(.Rows.Count, 1).End(-4162).Row ' -4162 = xlUp ' Capture the F/R data. For i = 1 To iDataRow ' 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 ' Else ' MsgBox "Cannot find the designated worksheet: " & StrWkSht, vbExclamation ' End If
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#9
|
|||
|
|||
@Macropod, your revised code worked! I tried it on a list I moved over into another word docx. It made every phrase bold, but they were also in the exact order as the excel list being used. I had also gone back and taken out most of the terms with commas.
However, when I ran the macro on a regular document, it had less than desirable effects. Many of the words were bolded, but some were only partially bolded. It also made many words bold that I would not have intended. I think this is pretty good, though, and I will just have to play around with changing the list to remove words and phrases that are causing trouble, repetitive words in phrases and such. Thank you both so much for your help. I've learned a great deal and I think I'm close to having a tool that will help me with productivity in the future. With gratitude, --David |
#10
|
||||
|
||||
Quote:
.MatchWholeWord = True when phrases are present. One way around that would be to test each term for the presence of one or more spaces. For example: Code:
'Process each string from the List For i = 1 To UBound(Split(xlFList, "|")) If UBound(Split(Split(xlFList, "|")(i), " ")) = 0 Then .MatchWholeWord = True Else .MatchWholeWord = False End If .Text = Split(xlFList, "|")(i) .Replacement.Text = "^&" .Execute Replace:=wdReplaceAll Next
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
Tags |
excel 2019, ms-word, vba |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Wildcards: searching for multiple words / expressions close to each other | ballpoint | Word VBA | 7 | 11-09-2017 03:30 PM |
Best Practice for Indexing Multiple Word Terms and Sub-Terms | jhy001 | Word | 4 | 11-06-2017 02:08 PM |
All words in document appear bold but are not! | Ezra | Word | 4 | 07-31-2017 06:53 AM |
Making Multiple Words Bold | mtk989 | Word | 2 | 06-25-2011 11:27 AM |
How to make a list of all the bold words in a document? | galaxy_110 | Word | 1 | 12-31-2010 08:23 AM |