Excel - Importing listobject table in another workbook to an array

80 Views Asked by At

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

2

There are 2 best solutions below

1
On BEST ANSWER

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
0
On

Thanks to @Ike for providing this,

The issue was indeed that my import table did not have data, so I modified the if statement as follows:

If Not PCws.ListObjects("ImportTable").DataBodyRange Is Nothing Then
    arrPC = PCws.ListObjects("ImportTable").DataBodyRange.Value
    PCws.ListObjects("ImportTable").DataBodyRange.ClearContents
End If