How to search for a string and highlight adjacent words? - vba

Question

I have a large MS Word document. To find information at a later date, I created an index to identify important subjects. A drawback to using indexes in MS Word is that they only show the page number of the information they are referencing (not the indexed words or sentence). I would like to highlight the section of the page that relates to the index (to make it easier to locate).
When creating an index, MS Word adds the index entry e.g. {XE "Index Phrase"} after the word or phrase being indexed. This index entry is only visible if viewing the document with formatting marks turned on. I found the below code and tweaked it a little to find the index by searching for "^d" and change the font color.
For users who don't want to view the document with formatting marks on, I would like to highlight the word or ideally sentence adjacent to the index entry.
I tried adjusting the code with the Moveleft method.
Sub ChangeWordColors()
Dim vWords As Variant
Dim sWord As Variant
vWords = Array("^d")
For Each sWord In vWords
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Font.Color = wdColorRed
With Selection.Find
.Text = sWord
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Next sWord
End Sub

Answer 1

For example:
Sub Demo()
Application.ScreenUpdating = False
Dim Fld As Field, Rng As Range
For Each Fld In ActiveDocument.Fields
If Fld.Type = wdFieldIndexEntry Then
Set Rng = Fld.Code
With Rng
.Start = .Start - 1
.Collapse wdCollapseStart
.MoveStart Unit:=wdSentence, Count:=-1
.Font.Color = wdColorRed
End With
End If
Next
Application.ScreenUpdating = True
End Sub
Do note, though, that VBA has no idea what a grammatic sentence is.