Sub FindFirstOccurrence() 'updated 2020-05-29 ' 'This macro takes a selection from one Word document and looks for its first occurrence in the body of a second document 'Running the macro twice in a row returns focus to the initial document but to the first appearance of the selected word in that document 'This macro also puts the selected term on the clipboard to facilitate searching for other appearances of the term 'This macro uses the macro ClearFindAndReplaceParameters and this must be installed for it to run properly ' 'Macro adapted by Hilary Powers 1/30/04; updated 4/6/04 'Adapted by Jack M. Lyon for use with editorial style sheet 'Adapted by Michael Schuler (https://bergerplusschuler.com) on 5/29/20 to expand functions Dim iNumWindows As Integer Dim sStyleSheetWord As String Const sDialogTitle As String = "Find First Occurence" On Error GoTo Err_Msg Application.ScreenUpdating = True Call ClearFindAndReplaceParameters iNumWindows = Application.Windows.Count If iNumWindows <> 2 Then MsgBox "This macro only works if two Word documents (the style sheet and the manuscript) are open.", vbExclamation, sDialogTitle GoTo Macroend End If If Selection.Type = wdSelectionIP Then 'No selection GoTo Headback Else While (Asc(Selection.Characters.Last) = 13) Or (Asc(Selection.Characters.Last) = 32) Or (Asc(Selection.Characters.Last) = 9) Or (Asc(Selection.Characters.Last) = 160) Selection.MoveEnd Unit:=wdCharacter, Count:=-1 If Selection.Type = wdSelectionIP Then MsgBox "No stylesheet term was selected.", vbExclamation, sDialogTitle GoTo Macroend End If Wend sStyleSheetWord = Selection.Text Selection.Copy WordBasic.NextWindow WordBasic.StartOfDocument With Selection.Find .ClearFormatting .Text = sStyleSheetWord .Forward = True .Wrap = wdFindAsk .Format = False .MatchCase = True .MatchWholeWord = True End With If Not Selection.Find.Execute Then MsgBox "The term " & Chr(34) & sStyleSheetWord & Chr(34) & " was not found.", vbExclamation, sDialogTitle Call ClearFindAndReplaceParameters GoTo Macroend End If Headback: WordBasic.NextWindow Macroend: Application.ScreenUpdating = True Exit Sub Err_Msg: MsgBox "The macro has encountered an error." & vbCrLf & Err.Number & ": " & Err.description, vbCritical, sDialogTitle End Sub Private Sub ClearFindAndReplaceParameters() 'from https://wordmvp.com/FAQs/MacrosVBA/ClearFind.htm 'can be run from any search to reset the search parameters With Selection.Find .ClearFormatting .Replacement.ClearFormatting .Text = "" .Replacement.Text = " " .Forward = True .Wrap = wdFindStop .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With End Sub