Quote Originally Posted by Aussiebear View Post
Without seeing the code, most people will simply be guessing, so be prepared for all sorts of answers.
OK. Here's the code, a little simplified ... 

Public aDocArray(1 To 10) As Variant    ' max no of docs
Public DocNameArray(1 To 10) As String  ' max no of docs
Public arrCnt As Integer
Public arrNoofDocs As Integer
Public sFRText As String
Public frmFRT As frmFRTPARTs

Sub FindIn()'   Find-Replace, inn PARTs I, II & III
' This routine opens the three documents and loads the userform.
' Clicking the START/NEXT/FINISH button on the userform simply calls the routine DoTDocs (see below)
' There is nothing else of any significance to this issue in the userform code


    Dim currDocFR As Word.Document
    Dim sStart As Long, sEnd As Long
    Dim currDocFRName As String
    
    If Documents.count < 1 Then
        MsgBox "Please open a document"
        Exit Sub
    End If
    
    Set currDocFR = Application.ActiveDocument
    
    If currDocFR.ActiveWindow.View.SplitSpecial <> wdPaneNone Then
        MsgBox "Please close any open endnote or other viewing pane"
        Exit Sub
    End If
    
    sStart = Selection.Start
    sEnd = Selection.End
    
    Application.ScreenUpdating = False
    
    '   Save selected text, if any
    If Selection.Start <> Selection.End Then
        sFRText = Selection.Text
        Selection.Collapse wdCollapseStart
    Else
        MsgBox "Please select a search string"
        Exit Sub
    End If
    
    Call OpenDoc("PART IV")                                             ' Path and filenames are correct. These are abbreviations for the sake of this post
    Set aDocArray(3) = Application.ActiveDocument
    DocNameArray(3) = "PART IV"
    
    Call OpenDoc("PART III")
    Set aDocArray(2) = Application.ActiveDocument
    DocNameArray(2) = "PART III"
        
    Call OpenDoc("PART II")
    Set aDocArray(1) = Application.ActiveDocument
    DocNameArray(1) = "PART II"
      
    arrNoofDocs = 3
    arrCnt = 1
    Set frmFRT = New frmFRTPARTs
    
    Call ClearFormatting1                      ' Does what it says
    Call API_NamedWindowOnTop("Find-Replace", 1290, 218)
    
End Sub


Sub DoTDocs()


'   On clicking the Start/Next button, we sequentially make each document PART active
'   If the user has selected a string in the original document, and that string is found,
'   we hand control back to the user until he clicks 'Next'.
'   Else we search the next document PART in sequence

'   ********** There are other buttons on the userform. Clicking these or any other part of the userform, brings the PART II document to the fore,
'even if the user was working on, say, the PART III or PART IV documents. THIS IS THE ESSENCE OF THE PROBLEM  ****************


    Dim doc As Document
    Dim aDoc As Document
    
Nextdoc:
    If arrCnt > arrNoofDocs Then
        Call CloseDocs
        MsgBox "Searched all requested documents"
        Set aDoc = Nothing
        Unload frmFRT
        Exit Sub
    End If
      
Nextdoc1:
    Set aDoc = aDocArray(arrCnt)
    arrCnt = arrCnt + 1
    On Error GoTo Nextdoc                                                                     ' If user has closed the doc, read next doc in array
    If IsFileOpen(DocNameArray(arrCnt - 1)) = False Then GoTo Nextdoc   ' On Error GoTo Nextdoc does not always catch it
    aDoc.Activate
    frmFRT.lblCurrDoc.Caption = aDoc & vbCrLf & vbCrLf & "Search string:" & vbCrLf & vbCrLf & sFRText
    
    If arrCnt > arrNoofDocs Then
        frmFRT.cmdDoTDocs.Caption = "Finish"
    Else
        frmFRT.cmdDoTDocs.Caption = "Next PART"
    End If
    
    frmFRT.cmdSearchNext.Enabled = True
    frmFRT.Repaint
    DoEvents
    
    Selection.HomeKey Unit:=wdStory
    With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = sFRText
        .Replacement.Text = sFRText
        .Wrap = wdFindAsk
        .Forward = True
        .Format = False
        .MatchCase = frmFRT.chkMatchCase
        .MatchWholeWord = frmFRT.chkWholeWord
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With


    If Selection.Find.Execute = False Then
        If Application.ActiveDocument = aDoc Then
            aDoc.Close                                                        'Close doc after not finding the string
        End If
        GoTo Nextdoc
    End If
    
    ' If string found or no string selected
    Set aDoc = Nothing
    Application.ScreenUpdating = True
    Call PosTopToMid(True)                                            ' Position found text 10 lines down from the top of the screen
    CommandBars("Edit").Controls("Replace...").Execute  ' Find & Replace


End Sub


Sub CloseDocs()
    Dim i As Integer
    Dim aDoc As Document
    
    For i = 1 To arrNoofDocs
        Set aDoc = aDocArray(i)
        If IsFileOpen(DocNameArray(i)) = True Then aDoc.Close
    Next
End Sub