Find and highlight formatting - issue with big documents

[rook]

You might try:

Public Sub SrcAndRplInStory(ByVal rngStory As Word.Range, lngRouter As Long)
  With rngStory.Find
    Select Case lngRouter
      Case 1
        .Font.Bold = True
        While .Execute
          rngStory.HighlightColorIndex = wdGreen
          rngStory.Collapse wdCollapseEnd
          DoEvents
        Wend
      Case 2
        .Font.Italic = True
        While .Execute
          rngStory.HighlightColorIndex = wdRed
          rngStory.Collapse wdCollapseEnd
          DoEvents
        Wend
      Case 3
        .Font.Underline = wdUnderlineSingle
        While .Execute
          rngStory.HighlightColorIndex = wdYellow
          rngStory.Collapse wdCollapseEnd
          DoEvents
        Wend
    End Select
  End With
End Sub

Dear Greg, this is perfect, thank you! I can't tell you how much time I have spent trying to figure this out... and you made it look so elegant and easy! THANK YOU, and thank you for all the follow-ups!!!