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