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