Find word and highlight line within selected text

[Dave T]

Hello All,

I would like to be able to select / highlight a block of text and use the following find and highlight macro to step through the selected text and when each instance of a specified word is found it highlights the line.

A while ago Greg Maxey helped me out with a macro which I have modified to suit my needs and works well, however the macro searches for the specified word within the whole document and I would like to restrict its operation to just to the text that has been selected / highlighted.

Can someone please tell me what changes need to be made to the following macro so that it is restricted to the selected text only?


Sub FindWordHighlightLine()
'http://www.vbaexpress.com/forum/showthread.php?t=39296
' Code written by Greg Maxey
Dim myRange As Range
Set myRange = ActiveDocument.Range
With myRange.Find
.Text = InputBox("Text to highlight")
Do While .Execute
.Wrap = wdFindStop
.Forward = True
myRange.Select
ActiveWindow.ScrollIntoView Selection.Range
Select Case MsgBox("Do you want to highlight this line?", vbQuestion + vbYesNoCancel, "Highlight line")
Case vbYes
Selection.Bookmarks("\line").Select
With Selection.Shading
.Texture = wdTextureNone
.ForegroundPatternColor = wdColorAutomatic
.BackgroundPatternColor = wdColorLightTurquoise
End With
Case vbNo
myRange.Collapse wdCollapseEnd
Case Else
GoTo lbl_Exit
End Select
Loop
End With
lbl_Exit:
Exit Sub
End Sub

Any help or pointers would be appreciated.

Regards,
Dave T

[gmaxey]

Sub FindWordHighlightLine()
'Code written by Greg Maxey
Dim myRange As Range
Dim oRngBounds As Range
Set myRange = Selection.Range
Set oRngBounds = myRange.Duplicate
With myRange.Find
.Text = InputBox("Text to highlight")
.Wrap = wdFindStop
.Forward = True
Do While .Execute
If Not myRange.InRange(oRngBounds) Then Exit Sub
myRange.Select
ActiveWindow.ScrollIntoView Selection.Range
Select Case MsgBox("Do you want to highlight this line?", vbQuestion + vbYesNoCancel, "Highlight line")
Case vbYes
Selection.Bookmarks("\line").Select
With Selection.Shading
.Texture = wdTextureNone
.ForegroundPatternColor = wdColorAutomatic
.BackgroundPatternColor = wdColorLightTurquoise
End With
Case vbNo
'Do nothing.
Case Else
GoTo lbl_Exit
End Select
myRange.Collapse wdCollapseEnd
Loop
End With
lbl_Exit:
Exit Sub
End Sub

[Dave T]

Hello Greg,

Your changes work perfectly.
I really do appreciate your help.

Regards,
Dave T

[tinakidlee]

Hello Greg,

How would the same code work to have the option to loop back and select a different text and a different highlight color? I need to check documents to be sure lines have not been repeated in error and I typically have to do this manually. I will copy and replace the same text with a highlight on the replace changing colors on each different variation. Once I have all options highlighted, a quick visual scan will allow me to see if two items have been repeated sequentially, which would be an error. Not what I use but an example would be:
Incorrect: Apples, Apples, Oranges, Figs, Grapes, Apples, Oranges, Oranges, Figs, Grapes. I am actually looking for speaker tags to be sure the correct speaker labels have been used, but the above example seems easier. Your code is so much simpler than anything I have used in the past.