Iterate to find ListObject in a workbook

I am trying to find a table (ListObject) in an Excel workbook, let's say workbook 2, after opening the same through a VBA subroutine in another workbook, let's say workbook 1.

Sub B()
    Dim TBL_EMP As ListObject
    Dim strFile As Variant
    Dim WS_Count As Integer
    
    strFile = "File Path"
    Set WB_TRN = Workbooks.Open(strFile)
    
    WS_Count = WB_TRN.Worksheets.Count
    For n = 1 To WS_Count
        On Error GoTo Next_IT
        Set TBL_EMP = WB_TRN.Worksheets(n).ListObjects("EmployeeNameTbl")
        If Not TBL_EMP Is Nothing Then
            MsgBox "Object Found"
        End If
Next_IT:
    Next n
End Sub

When I run the subroutine it iterates two sheets and gives error code 9

Subscript Out of Range

Workbook 2 has 10 worksheets.

If I open workbook 2 through file open dialogue box the code works.

Solution

Referencing a Table in a Workbook

A 'Sub' Example

Sub LocateTableExample()
    
    Const FilePath As String = "C:\Test\Test.xlsx"
    Const TableName As String = "EmployeeNameTbl"
    
    Dim wb As Workbook: Set wb = Workbooks.Open(FilePath)
    'Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim tbl As ListObject
    Dim IsFound As Boolean
    
    Dim ws As Worksheet
    For Each ws In wb.Worksheets
        On Error Resume Next
            Set tbl = ws.ListObjects(TableName)
        On Error GoTo 0
        If Not tbl Is Nothing Then
            IsFound = True
            Exit For ' stop looping, it is found
        End If
    Next ws

    ' Continue using the 'tbl' and 'ws' variables.
    Debug.Print tbl.Name
    Debug.Print ws.Name

            
    If IsFound Then
        MsgBox "Table found in worksheet '" & ws.Name & "'.", vbInformation
    Else
        MsgBox "Table not found.", vbCritical
    End If
    
End Sub

Using a Function

The procedure ReferenceTableTest utilizes (calls) the following ReferenceTable function.

Sub ReferenceTableTest()
    
    Const FilePath As String = "C:\Test\Test.xlsx"
    Const TableName As String = "EmployeeNameTbl"
        
    Dim wb As Workbook: Set wb = Workbooks.Open(FilePath)
    'Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim tbl As ListObject: Set tbl = ReferenceTable(wb, TableName)
    If tbl Is Nothing Then Exit Sub
    
    Debug.Print "Get the Names Using the 'tbl' variable"
    Debug.Print "Table Name:     " & tbl.Name
    Debug.Print "Worksheet Name: " & tbl.Range.Worksheet.Name
    Debug.Print "Workbook Name:  " & tbl.Range.Worksheet.Parent.Name
    
End Sub

Function ReferenceTable( _
    ByVal wb As Workbook, _
    ByVal TableName As String) _
As ListObject
    Const ProcName As String = "ReferenceTable"
    On Error GoTo ClearError
    
    Dim ws As Worksheet
    Dim tbl As ListObject
    
    For Each ws In wb.Worksheets
        On Error Resume Next
            Set tbl = ws.ListObjects(TableName)
        On Error GoTo 0
        If Not tbl Is Nothing Then
            Set ReferenceTable = tbl
            Exit For
        End If
    Next ws
    
ProcExit:
    Exit Function
ClearError:
    Debug.Print "'" & ProcName & "': Unexpected Error!" & vbLf _
              & "    " & "Run-time error '" & Err.Number & "':" & vbLf _
              & "    " & Err.Description
    Resume ProcExit
End Function