Home > Blockchain >  Get the Listobject Range without the Sheet Specification
Get the Listobject Range without the Sheet Specification

Time:10-16

I have multiple tables in the workbook in different sheets. All the tables scope is Workbook as can be seen in the pic.

Table list in the workbook

Using VBA, is there a way to get this object assign to a ListObject variable without defining the SheetName?

CodePudding user response:

If I got you right and according to your screenshot you could use the following code for tblStage

Dim lo As ListObject    
Set lo = Range("tblStage").ListObject

Reading material 1 2

CodePudding user response:

Reference an Excel Table When Its Worksheet Is Not Known

  • When is it useful?

  • When there is a chance that somebody would rename the worksheet or move the table to another worksheet since you usually want to do e.g.:

    Dim tbl As ListObject
    Set tbl = ThisWorkbook.Worksheets("Sheet1").Listobjects("Table1")
    
  • In the second case, even using the sheet code name won't save you, e.g.:

    Set tbl = Sheet1.ListObjects("Table1")
    

Method (Compact)

Sub TableByName()

    Const TableName As String = "Table1"

    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code

    ' Prevent "RTE '1004': Method 'Range' of object '_Global' failed"
    ' when the wrong workbook is active:
    If Not wb Is ActiveWorkbook Then wb.Activate

    Dim tbl As ListObject
    
    On Error Resume Next
        Set tbl = Range(TableName).ListObject
    On Error GoTo 0
    
    If tbl Is Nothing Then Exit Sub ' table not found

    With tbl
        Debug.Print .Name, .Range.Worksheet.Name, .Range.Address, _
            .DataBodyRange.Address, .ListRows.Count, .ListColumns.Count
    End With
    
End Sub

Using a Function

Sub SetTableByNameExample()

    Const TableName As String = "Table1"

    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code

    Dim tbl As ListObject: Set tbl = SetTableByName(wb, TableName)
    
    If tbl Is Nothing Then Exit Sub ' table not found
    
    With tbl
        Debug.Print .Name, .Range.Worksheet.Name, .Range.Address, _
            .DataBodyRange.Address, .ListRows.Count, .ListColumns.Count
    End With
    
End Sub

Function SetTableByName( _
    ByVal wb As Workbook, _
    ByVal TableName As String) _
As ListObject
    
    ' Prevent "RTE '1004': Method 'Range' of object '_Global' failed"
    ' when the wrong workbook is active:
    If Not wb Is ActiveWorkbook Then wb.Activate
    
    On Error Resume Next
        SetTableByName = Range(TableName).ListObject
    On Error GoTo 0

End Function

CodePudding user response:

Range("Table1").ListObject will return a reference to the ListObject. But I would never use it because it only works on the ActiveWorkbook. IMO, it would be better to write a function to return a collection of ListObjects form a Workbook:

Function ListObjects(Optional wb As Workbook) As Collection
    If wb Is Nothing Then Set wb = ActiveWorkbook

    Dim Objects As New Collection
    Dim ws As Worksheet
    Dim ListObject As ListObject
    Dim Collection As New Collection
    For Each ws In wb.Worksheets
        For Each ListObject In ws.ListObjects
            Collection.Add ListObject, ListObject.Name
        Next
    Next
    Set ListObjects = Collection
End Function

From my Personal Macros workbook I run code that creates/updates a module with a function for each ListObject in a Workbook. I simply activate the Workbook and run UpdateListObjects from the Immediate Window.

Module Image

Note: A reference to Microsoft Visual Basic for Applications Extensibility 5.3 and Trust access to the VBA project object model will need to be enabled.

Sub UpdateListObjects(Optional wb As Workbook, Optional ModuleName As String = "TableDefs")
    Const WarningMessage As String = "Rem This Module is auto updated" & vbNewLine & "Rem Do Not Edit!!" & vbNewLine
    
    If wb Is Nothing Then Set wb = ActiveWorkbook
    Dim Map As Collection
    Set Map = ListObjects(wb)
    
    If Map.Count = 0 Then Exit Sub
    
    ReDim TableDefs(0 To Map.Count) As String
    TableDefs(0) = WarningMessage
    
    Dim n As Long
    
    For n = 1 To Map.Count
        TableDefs(n) = TableDef(Map(n))
    Next
    
    With TableDefVBComponent(wb, ModuleName).CodeModule
        .DeleteLines 1, .CountOfLines
        .AddFromString Join(TableDefs, String(2, vbNewLine))
    End With
    
End Sub

Function ListObjects(Optional wb As Workbook) As Collection
    If wb Is Nothing Then Set wb = ActiveWorkbook

    Dim Objects As New Collection
    Dim ws As Worksheet
    Dim ListObject As ListObject
    Dim Collection As New Collection
    For Each ws In wb.Worksheets
        For Each ListObject In ws.ListObjects
            Collection.Add ListObject, ListObject.Name
        Next
    Next
    Set ListObjects = Collection
End Function

Function TableDef(ListObject As ListObject) As String
    Dim ws As Worksheet
    Set ws = ListObject.Parent
    
    Dim Lines(2) As String
    Lines(0) = "Function " & ListObject.Name & "() As ListObject"
    Lines(1) = vbTab & "set " & ListObject.Name & " = " & ws.CodeName & ".ListObjects(" & Chr(34) & ListObject.Name & Chr(34) & ")"
    Lines(2) = "End Function "
    
    TableDef = Join(Lines, vbNewLine)
    
End Function

Private Function TableDefVBComponent(Optional wb As Workbook, Optional ModuleName As String = "TableDefs") As VBComponent
    If wb Is Nothing Then Set wb = ActiveWorkbook
    Dim Component As VBComponent
    
    On Error Resume Next
    Set Component = wb.VBProject.VBComponents(ModuleName)
    On Error GoTo 0
    
    If Component Is Nothing Then
        Set Component = wb.VBProject.VBComponents.Add(vbext_ComponentType.vbext_ct_StdModule)
        Component.Name = ModuleName
    End If
    
    Set TableDefVBComponent = Component
End Function

CodePudding user response:

This function returns table as ListObject with or without workbook specified

Function GetTableLO(tableName As String, Optional wb As Workbook = Nothing) As ListObject
On Error GoTo EH
    Set GetTableLO = Nothing
    If wb Is Nothing Then 'ActiveWorkbook assumed
        Set GetTableLO = Range(tableName).ListObject
    Else
        Set GetTableLO = Evaluate("'" & wb.Name & "'!" & tableName).ListObject
    End If
EH:
End Function
  • Related