|
|
Thread Tools | Display Modes |
#1
|
|||
|
|||
Macro To Identify & Highlight Words In MS Word Based Upon A List In Excel File Column
Hi,
I am a writer and I have a list of words in Excel (adverbs, prepositions, cliches etc) that need to be identified and highlighted as I write in Word so I can edit them out when necessary. I was looking for a solution and I was told the best one was a suitable Macros. The Macros code for a very similar problem (identifying and replacing instead of identifying and highlighting) was given on a different thread, so I was hoping I could also get the code for a Macros that did the job I wanted. Also, I searched for such a macros on other threads, but couldn't locate it. So if the answer has already been given elsewhere, I will be glad if I could be pointed to that thread. Thanks in advance |
#2
|
||||
|
||||
Try, for example:
Code:
Sub BulkHighlighter() Application.ScreenUpdating = False Dim xlApp As Object, xlWkBk As Object, StrWkBkNm As String Dim iDataRow As Long, xlList As String, h As Long, i As Long StrWkBkNm = "C:\Users\" & Environ("Username") & "\Documents\WordList.xlsx" 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(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("Sheet1") ' 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 xlList = xlList & "|" & 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 xlList = "" Then Exit Sub h = Options.DefaultHighlightColorIndex Options.DefaultHighlightColorIndex = wdBrightGreen With ActiveDocument.Range.Find .ClearFormatting .Replacement.ClearFormatting .MatchWholeWord = True .MatchCase = True .Wrap = wdFindContinue .Replacement.Text = "^&" .Replacement.Highlight = True 'Process each word from the List For i = 1 To UBound(Split(xlList, "|")) .Text = Split(xlList, "|")(i) .Execute Replace:=wdReplaceAll Next End With Options.DefaultHighlightColorIndex = h Application.ScreenUpdating = True End Sub For PC macro installation & usage instructions, see: Installing Macros
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#3
|
||||
|
||||
Another approach would be as follows. Name the column of Words (without empty cells and omitting the header row if any) as WordList. Then run the following to highlight the listed words. Change the value of strWorkbook as appropriate.
The Excel range is read into an array (without opening Excel) and that array is interrogated to get the words. Code:
Sub Highlight_Words_From_Excel_NamedRange() 'Graham Mayor - https://www.gmayor.com - Last updated - 20 Mar 2020 Const strWorkbook As String = "C:\Path\Word List.xlsx" 'The workbook path Const strRange As String = "WordList" 'The named Excel range Dim arr() As Variant Dim lngRows As Long Dim oRng As Range Dim strFind As String arr = xlFillArray(strWorkbook, strRange) For lngRows = 0 To UBound(arr, 2) strFind = arr(0, lngRows) Set oRng = ActiveDocument.Range With oRng.Find Do While .Execute(findText:=strFind) oRng.HighlightColorIndex = wdYellow oRng.Collapse 0 Loop End With Next lngRows lbl_Exit: Exit Sub End Sub Private Function xlFillArray(strWorkbook As String, _ strRange As String) As Variant 'Graham Mayor - http://www.gmayor.com - 24/09/2016 Dim RS As Object Dim CN As Object Dim iRows As Long strRange = strRange & "]" Set CN = CreateObject("ADODB.Connection") CN.Open ConnectionString:="Provider=Microsoft.ACE.OLEDB.12.0;" & _ "Data Source=" & strWorkbook & ";" & _ "Extended Properties=""Excel 12.0 Xml;HDR=NO;IMEX=1""" Set RS = CreateObject("ADODB.Recordset") RS.Open "SELECT * FROM [" & strRange, CN, 2, 1 With RS .MoveLast iRows = .RecordCount .MoveFirst End With xlFillArray = RS.GetRows(iRows) If RS.State = 1 Then RS.Close Set RS = Nothing If CN.State = 1 Then CN.Close Set CN = Nothing lbl_Exit: Exit Function End Function
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#4
|
|||
|
|||
Quote:
Thanks a lot Paul. Let me check this out. |
#5
|
|||
|
|||
Quote:
Thanks a ton Graham. Let me check this out as well. |
#6
|
||||
|
||||
I only just noticed your profile says you're using a Mac. In that case, you'll need to change the path and its separators to suit a Mac.
For Mac macro installation & usage instructions, see: Word:mac - Install a Macro
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
Tags |
editing a document, macros |
Thread Tools | |
Display Modes | |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Highlight words from a list | Nanaia | Word VBA | 3 | 09-07-2018 02:13 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 |
Macro to highlight repeated words in word file and extract into excel file | aabri | Word VBA | 1 | 06-14-2015 07:20 AM |
Highlight Words from a Word List | JSC6 | Word VBA | 1 | 09-30-2014 08:22 PM |