Sub WildcardLoader()
' Paul Beverley - Version 07.02.24
' Tool for using wildcard searches


doPrompt = False

' These pre-checks were aimed at use with Macro Menu
If Selection.start = Selection.End Then
  Set rng = Selection.Range.Duplicate
  rng.Expand wdParagraph
  rng.MoveEnd , -1
  mySearch = rng.Text
  myCheck = Replace(mySearch, "[", "")
  myCheck = Replace(myCheck, "*", "")
  myCheck = Replace(myCheck, "<", "")
  myCheck = Replace(myCheck, ">", "")
  If myCheck = mySearch And rng.Words.count = 2 Then
    If Selection.End = rng.End Then rng.Select
    If Selection.End = rng.start Then Selection.MoveEnd , 2
  End If
End If

On Error GoTo ReportIt
If Selection.start = Selection.End Then
  ' Add a delay to let blasted MS Word catch up, and
  ' if there's no delay, it goes wrong!
  Set rng = Selection.Range.Duplicate
  rng.Expand wdParagraph
  If Len(rng) = 1 Then
    Selection.TypeText Text:=Selection.Find.Text
    Exit Sub
  Else
    ' If not a WC, then open an input box
    rng.MoveEnd , -1
    mySearch = rng.Text
    myCheck = Replace(mySearch, "[", "")
    myCheck = Replace(myCheck, "*", "")
    myCheck = Replace(myCheck, "<", "")
    myCheck = Replace(myCheck, ">", "")
    
    If myCheck <> mySearch Then
      ' It's a WC
      doWC = True
    Else
      doWC = False
    ' Warn if too long
      If Len(mySearch) > 254 Then
        myResponse = MsgBox("Search text too long!", _
             vbOKOnly, "WildcardLoader")
        rng.Select
        Exit Sub
      End If
      mySearch = rng
      rng.Select
      Selection.Collapse wdCollapseEnd
    End If
  End If
Else
  If Right(Selection, 1) = vbCr Then _
       Selection.MoveEnd , -1
  If InStr(Trim(Selection), " ") = 0 Then
  ' Only one word selected? Switch order of FollowedBy
    doWC = True
    myText = Selection.Find.Text
    wcPos = InStr(myText, "[!^13]@")
    If wcPos > 0 Then
      myLast = Left(myText, wcPos - 1)
      myFirst = Mid(myText, wcPos + 7)
      mySearch = myFirst & "[!^13]@" & myLast
    Else
    ' If not a FollowedBy then inform user
      Beep
      myResponse = MsgBox("Current find:  " & myText & vbCr & vbCr & _
           "For word-pair search, select the two words." _
           , vbOKOnly, "WildcardLoader")
      Exit Sub
    End If
  Else
  ' Set up FollowedBy
    doWC = True
    Set rng = Selection.Range.Duplicate
    rng.MoveEnd , -1
    rng.Collapse wdCollapseEnd
    rng.Expand wdWord
    Do While InStr(ChrW(8217) & "' ", _
         Right(rng.Text, 1)) > 0
      rng.MoveEnd , -1
      DoEvents
    Loop
    Selection.Collapse wdCollapseStart
    Selection.Expand wdWord
    Selection.Collapse wdCollapseStart
    rng.start = Selection.start
    rng.Select
    myFirst = Trim(Selection.Range.Words.First)
    apoPos = InStr(myFirst, ChrW(8217))
    If apoPos > 0 Then myFirst = Left(myFirst, _
         apoPos - 1)
    init = Left(myFirst, 1)
    If LCase(init) <> UCase(init) Then _
         myFirst = "[" & LCase(init) & _
         UCase(init) & "]" & Mid(myFirst, 2)
    myLast = Trim(Selection.Range.Words.Last)
    init = Left(myLast, 1)
    If LCase(init) <> UCase(init) Then _
         myLast = "[" & LCase(init) & UCase(init) & "]" _
         & Mid(myLast, 2)
    mySearch = myFirst & "[!^13]@" & myLast
  End If
End If

' Go find WC
Selection.Collapse wdCollapseEnd
hereNow = Selection.start
Set rng = Selection.Range.Duplicate
With Selection.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Wrap = wdFindStop
  .Text = mySearch
  .Replacement.Text = ""
  .MatchWildcards = doWC
  .Forward = True
  .Execute
  If .Found = True Then
    Selection.Collapse wdCollapseStart
    Selection.MoveLeft , 1
    .Execute
  End If

End With
If Selection.start = hereNow And _
     Selection.Find.Found = False Then Beep
' Leaves F&R dialogue in a sensible state
Selection.Find.Wrap = wdFindContinue

If Selection.End = 0 Then
  Beep
  myTime = Timer
  Do
  Loop Until Timer > myTime + 0.2
  Beep

  rng.Select
  If doPrompt = True Then myResponse = _
       MsgBox("Sorry, Word's Find is confused by the embedded fields." _
       & vbCr & vbCr _
       & "Try searching in a text-only copy.", _
       vbOKOnly, "WildcardLoader")
    Selection.EndKey Unit:=wdStory
    With Selection.Find
      .Wrap = wdFindStop
      .Forward = False
      .Execute
    ' Leave F&R dialogue in a sensible state
      .Wrap = wdFindContinue
      .Forward = True
    End With
    If doPrompt = True Then myResponse = _
         MsgBox("...So I went to the end and searched upwards! OK?", _
         vbOKOnly, "FindFwd")
End If
Exit Sub

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