Sub InstantFindUp()
' Paul Beverley - Version 13.01.21
' Finds selected text upwards

doTrim = True
addBookmark = True
butNotTheseFiles = "zzSwitchList,ComputerTools4Eds,TheMacros,5_Library"

If Selection.Start = Selection.End Then
  Selection.Expand wdWord
  Do While InStr(ChrW(8217) & "' ", Right(Selection.Text, 1)) > 0
    Selection.MoveEnd , -1
    DoEvents
  Loop
End If

DoEvents
thisBit = Selection
makeWild = False
If Right(thisBit, 1) = ">" Then makeWild = True
If Left(thisBit, 1) = "<" Then makeWild = True
wordEnd = Selection.End
Selection.Collapse wdCollapseStart
myName = ActiveDocument.Name
dotPos = InStr(myName, ".")
If dotPos > 0 Then myName = Left(myName, dotPos - 1)
noMarker = (InStr(butNotTheseFiles, myName) > 0)
If InStr(myName, "Ch") > 0 Then noMarker = True
If addBookmark = True And noMarker = False Then _
     ActiveDocument.Bookmarks.Add Name:="myTempMark2"

If Asc(thisBit) <> 32 And doTrim Then thisBit = Trim(thisBit)
thisBit = Replace(thisBit, "^", "^^")
If makeWild = True Then
  thisBit = Replace(thisBit, vbCr, "^p")
Else
  thisBit = Replace(thisBit, vbCr, "^13")
End If
thisBit = Replace(thisBit, vbTab, "^t")

Selection.End = Selection.Start
hereNow = Selection.Start
With Selection.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Wrap = wdFindStop
  .Forward = False
  .Text = thisBit
  .Replacement.Text = thisBit
  .MatchCase = False
  If UCase(thisBit) = thisBit Then .MatchCase = True
  .MatchWildcards = makeWild
  .MatchWholeWord = False
  .MatchSoundsLike = False
  .Execute
End With
' Leave F&R dialogue in a sensible state
Selection.Find.Forward = True
Selection.Find.Wrap = wdFindContinue

If Selection.Start = hereNow And _
     Selection.Find.Found = False Then Beep
End Sub