Sub InstantFindTop()
' Paul Beverley - Version 18.11.10
' Find this from the top

If Selection.Start = Selection.End Then
  Selection.MoveRight Unit:=wdWord, Count:=1
  Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdExtend
End If

thisBit = Trim(Selection)
Selection.Start = Selection.End
Selection.HomeKey Unit:=wdStory
With Selection.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Wrap = False
  .Text = thisBit
  .Replacement.Text = thisBit
  .MatchWildcards = False
  .MatchWholeWord = False
  .MatchCase = False
  .Forward = True
  .Execute
End With
' Move the screen display down a couple of lines
Selection.MoveUp Unit:=wdLine, Count:=2
Selection.MoveDown Unit:=wdLine, Count:=2
Selection.Find.Execute
' Leaves F&R dialogue in a sensible state
Selection.Find.Wrap = wdFindContinue
End Sub