Find word and highlight line within selected text

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?

Code:

---

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

Code:

---

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

---

Hello Greg,

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

Regards,
Dave T

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.