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