Sub InstantFindFormatDown()
' Paul Beverley - Version 10.09.10
' Find format similar to this

hereNow = Selection.Start
isSuper = Selection.Font.Superscript
thisBit = Trim(Selection)
If Selection.End = Selection.Start Then
  thisBit = ""
  Selection.MoveEnd , 1
End If
isSuper = Selection.Font.Superscript
isSub = Selection.Font.Subscript
isItalic = Selection.Font.Italic
isBold = Selection.Font.Bold
Selection.MoveStart , 10
Selection.End = Selection.Start
With Selection.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Wrap = False
  If isSuper Then .Font.Superscript = True
  If isSub Then .Font.Subscript = True
  If isItalic Then .Font.Italic = True
  If isBold Then .Font.Bold = True
  .Text = thisBit
  .Replacement.Text = thisBit
  .MatchWildcards = False
  .MatchWholeWord = False
  .MatchSoundsLike = False
  .MatchCase = False
  .Forward = True
  .Execute
End With
If Selection.End = hereNow Then beep
If Selection.Start = hereNow + 10 Then
  beep
  Selection.Start = hereNow
  Selection.End = hereNow
End If

' Leave F&R dialogue in a sensible state
Selection.Find.Wrap = wdFindContinue
End Sub