#1
|
|||
|
|||
Find and highlight multiple words in MS Word document
Through searching for older post, i found this formula below, however, as for the StrFnd part, it appears that there are too many words i entered inside the string and it split the rest to the next column and that makes the remain words exclude from the string. How can i alternate the formula so i can include a large amount of words in String for search. Thanks
Sub HiLightList() Application.ScreenUpdating = False Dim StrFnd As String, Rng As Range, i As Long StrFnd = "dog,cat,pig,horse,man" For i = 0 To UBound(Split(StrFnd, ",")) Set Rng = ActiveDocument.Range With Rng.Find .ClearFormatting .Text = Split(StrFnd, ",")(i) .Replacement.ClearFormatting .Replacement.Highlight = True .Replacement.Text = "^&" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = True .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = True .Execute Replace:=wdReplaceAll End With Next Set Rng = Nothing Application.ScreenUpdating = True End Sub |
#2
|
||||
|
||||
Put the words in the first column of a table and save the document (sfName). Then use the following:
Code:
Sub HiLightFromTableList() Dim oChanges As Document, oDoc As Document Dim oTable As Table Dim oRng As Range Dim rFindText As Range Dim i As Long Dim sfName As String Dim sAsk As String sfName = "C:\Path\Find.docx" Set oDoc = ActiveDocument Set oChanges = Documents.Open(FileName:=sfName, Visible:=False) Set oTable = oChanges.Tables(1) For i = 1 To oTable.Rows.Count Set oRng = oDoc.Range Set rFindText = oTable.Cell(i, 1).Range rFindText.End = rFindText.End - 1 With oRng.Find Do While .Execute(FindText:=rFindText, _ MatchCase:=False, _ MatchWholeWord:=True, _ MatchWildcards:=False, _ Forward:=True, _ Wrap:=wdFindStop) = True oRng.HighlightColorIndex = wdTurquoise oRng.Collapse wdCollapseEnd Loop End With DoEvents Next i oChanges.Close wdDoNotSaveChanges lbl_Exit: Exit Sub End Sub Code:
Sub Macro1() Const strWorkbook As String = "C:\Path\Highlight.xlsx" Const strSheet As String = "Sheet1" Dim strFind As String Dim oRng As Range Dim i As Long Dim Arr() As Variant Arr = xlFillArray(strWorkbook, strSheet) For i = 0 To UBound(Arr, 2) strFind = Arr(0, i) Set oRng = ActiveDocument.Range With oRng.Find Do While .Execute(FindText:=strFind, _ MatchCase:=False, _ MatchWholeWord:=True, _ MatchWildcards:=False, _ Forward:=True, _ Wrap:=wdFindStop) = True oRng.HighlightColorIndex = wdTurquoise oRng.Collapse wdCollapseEnd Loop End With DoEvents Next i Set oRng = Nothing 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 & "$]" 'Use this to work with a named worksheet 'strRange = strRange & "]" 'Use this to work with a named range Set CN = CreateObject("ADODB.Connection") 'Set HDR=NO for no header row CN.Open ConnectionString:="Provider=Microsoft.ACE.OLEDB.12.0;" & _ "Data Source=" & strWorkbook & ";" & _ "Extended Properties=""Excel 12.0 Xml;HDR=YES"";" 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 |
#3
|
|||
|
|||
Quote:
|
#4
|
||||
|
||||
Yes - For the first option, create a table in a Word document, for the second create an Excel workbook. They will work with Office 2010.
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#5
|
|||
|
|||
Thanks for your help gmayor!
i have tried the code out, however, with this code ( sfName = "C:\Path\Find.docx") there is a message box saying something error '5174' and can not find document ( C:\Path\Find.docx). How should i solve this? Thanks alot |
#6
|
|||
|
|||
Or should i copy the location path in and replace it to the path part, and replace sfName.docx with Find.docx?
|
#7
|
||||
|
||||
"C:\Path\Find.docx" is the name and path of the document with the table. If you have named it something else, or stored it somewhere else, make the changes in the line
sfName = "C:\Path\Find.docx" to reflect what you have done,
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#8
|
|||
|
|||
Sorry for the late reply. Thx GMAYOR it worked perfectly. Your are such a saviour!!
|
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 |
Find and highlight multiple words in a document | flatop | Word VBA | 3 | 04-16-2014 10:29 PM |
Highlight and then replace multiple words | redhin | Word VBA | 5 | 03-05-2013 05:42 AM |
Find and highlight all words ending in -ly | RBLampert | Word VBA | 13 | 10-23-2012 04:45 PM |
find - reading highlight - highlight all / highlight doesn't stick when saved | bobk544 | Word | 3 | 04-15-2009 03:31 PM |