Search code examples
excelvbaexcel-tableslistobject

Excel - Importing listobject table in another workbook to an array


The code below is meant to import data from a defined table in another workbook to process in this workbook, after which it will clear the contents of the table in the source workbook.

It gives me the following error: Object variable not set (Error 91)

I tried the following code to import the data into the array. I would expect to be able to interact with the data in the array after the other workbook has been closed.

Sub Test()

    Dim arrPC As Variant
    Dim PCwb As Workbook
    Dim ws As Worksheet
    Dim PCws As Worksheet

    Set ws = ThisWorkbook.Sheets("MainSheet")    
    Set PCwb = Workbooks.Open("C:\Path\OtherWorkbook")
    Set PCws = PCwb.Sheets("ImportSheet")
    
    arrPC = PCws.ListObjects("ImportTable").DataBodyRange.Value

    If not isnull(arrPC) Then
        PCws.ListObjects("ImportTable").DataBodyRange.ClearContents
    End If
    
    PCwb.Close

End Sub

Forgive my inability to add this as in-code comment, but the code breaks on this line:

arrPC = PCws.ListObjects("ImportTable").DataBodyRange.Value


Solution

  • Import Data From Table in a Closed Workbook

    • It is infested with various checks. Remove the ones that seem redundant (ridiculous) to you.
    Sub ImportTableData()
        Const PROC_TITLE As String = "Import Table Data"
        On Error GoTo ClearError
        
        Const SRC_FILE_PATH As String = "C:\Test\OtherWorkbook.xlsx"
        Const SRC_SHEET_NAME As String = "ImportSheet"
        Const SRC_TABLE_NAME As String = "ImportTable"
        Const DST_SHEET_NAME As String = "MainSheet"
        
        If Len(Dir(SRC_FILE_PATH)) = 0 Then
            MsgBox "The file """ & SRC_FILE_PATH & """ was not found.", _
                vbExclamation, PROC_TITLE
            Exit Sub
        End If
        
        Dim swb As Workbook: Set swb = Workbooks.Open(SRC_FILE_PATH)
            
        Dim sws As Worksheet
        On Error Resume Next
            Set sws = swb.Sheets(SRC_SHEET_NAME)
        On Error GoTo ClearError
        
        If sws Is Nothing Then
            MsgBox "The worksheet """ & SRC_SHEET_NAME _
                & """ was not found in workbook """ & swb.Name & """!", _
                vbExclamation, PROC_TITLE
            GoTo ProcExit
        End If
            
        Dim slo As ListObject
        On Error Resume Next
            Set slo = sws.ListObjects(SRC_TABLE_NAME)
        On Error GoTo ClearError
        
        If slo Is Nothing Then
            MsgBox "The table """ & SRC_TABLE_NAME _
                & """ was not found in worksheet """ & sws.Name _
                & """ of workbook """ & swb.Name & """!", _
                vbExclamation, PROC_TITLE
            GoTo ProcExit
        End If
        
        If slo.DataBodyRange Is Nothing Then
            MsgBox "The table """ & slo.Name & """ is empty!", _
                vbExclamation, PROC_TITLE
            GoTo ProcExit
        End If
        
        If slo.ShowAutoFilter Then
            If slo.AutoFilter.FilterMode Then slo.AutoFilter.ShowAllData
        End If
        
        Dim sData() As Variant
        
        With slo.DataBodyRange
            If .Cells.CountLarge = 1 Then
                ReDim sData(1 To 1, 1 To 1)
                sData(1, 1) = .Value
            Else
                sData = .Value
            End If
        End With
        
        slo.DataBodyRange.ClearContents ' '.Delete' looks more appropriate
        swb.Close SaveChanges:=True
        Set swb = Nothing
    
        Dim dwb As Workbook: Set dwb = ThisWorkbook
    
        Dim dws As Worksheet
        On Error Resume Next
            Set dws = dwb.Sheets(DST_SHEET_NAME)
        On Error GoTo ClearError
        
        If dws Is Nothing Then
            MsgBox "The worksheet """ & DST_SHEET_NAME _
                & """ was not found in workbook """ & dwb.Name & """!", _
                vbExclamation, PROC_TITLE
            GoTo ProcExit
        End If
        
        ' Do your thing, e.g.:
        MsgBox "My destination worksheet is named """ & dws.Name _
            & """ and is located in the workbook containing this code named """ _
            & dwb.Name & """." & vbLf & "I'm going to process data retrieved " _
            & "in an array that has " & UBound(sData, 1) & " rows and " _
            & UBound(sData, 2) & " columns.", vbInformation, PROC_TITLE
    
    ProcExit:
        On Error Resume Next
            If Not swb Is Nothing Then swb.Close SaveChanges:=False
        On Error GoTo 0
        Exit Sub
    ClearError:
        MsgBox "Run-time error '" & Err.Number & vbLf & vbLf _
            & Err.Description, vbCritical, PROC_TITLE
        Resume ProcExit
    End Sub