Sub InstantFindDownWild()
' Paul Beverley - Version 23.02.23
' Finds selected text downwards wildcards set

selectWholeLine = True

addBookmark1 = True
addBookmark2 = False

On Error GoTo ReportIt

If Selection.Start = Selection.End And selectWholeLine = True _
     Then Selection.Expand wdParagraph
If Right(Selection.Text, 1) = vbCr Then Selection.MoveEnd , -1

thisBit = Selection
thisBit = Replace(thisBit, vbCr, "^13")
thisBit = Replace(thisBit, vbTab, "^t")

wordEnd = Selection.End
Selection.Collapse wdCollapseStart
If addBookmark1 = True Then ActiveDocument.Bookmarks.Add Name:="myTempMark"
If addBookmark2 = True Then ActiveDocument.Bookmarks.Add Name:="myTempMark2"
Selection.Start = wordEnd

Selection.Start = Selection.End
Set rng = Selection.Range.Duplicate
With Selection.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Wrap = wdFindStop
  .Text = thisBit
  .Replacement.Text = ""
  .MatchWildcards = True
  .MatchWholeWord = False
  .MatchCase = False
  .Forward = True
  .Execute
  .Wrap = wdFindContinue
End With
If Selection.Find.Found = False Then
  Beep
Else
  If Selection.End = 0 Then
    rng.Select
    Beep
    myResponse = MsgBox("Sorry, Word's Find facility is playing sillies!" _
         & vbCr & vbCr & "Try searching in a text-only copy.", _
         vbOKOnly, "InstantFindDownWild")
  End If
End If
Exit Sub

ReportIt:
asdfgsdf = Err.Number
If Err.Number = 5560 Then
  Beep
  MsgBox ("Bad pattern match!")
Else
  On Error GoTo 0
  Resume
End If
End Sub