Auto Resize table-CodePudding

I am making a dynamic sheet directory in excel using VBA that I would like to dynamically resize. It does resize if new data is added, but not if it is removed. Here is my code:

Sub update_directory()
Application.ScreenUpdating = False
Range("Directory").Select
Selection.ClearContents
Range("AA1").Select
ActiveCell.Formula2R1C1 = "=TRANSPOSE(SheetNames)"
Sheet1.Calculate
Range("AA1").CurrentRegion.Select
Selection.Copy
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues
Range("AA1").CurrentRegion.Select
Selection.Clear
Columns("A:B").EntireColumn.AutoFit
''Table Auto resize
Range("A2").Select
Application.ScreenUpdating = True
End Sub

Directory is my table name, and SheetNames is a name to list sheet names in an array defined as:

=REPLACE(GET.WORKBOOK(1),1,FIND("]",GET.WORKBOOK(1)),"")&T(NOW())

Screenshot of the table: Table

Is there a single line piece of code to achieve a table resize? Any help is appreciated.

CodePudding user response：

You don't need all those selects and copy/pastes

The procedure first stores the reuslt of Transpose(Sheetnames) into an array. This has two advantages:

writing an array to a worksheet is faster and cleaner then using select/copy/paste
we know the size of the array - and from that can resize the listobject/table.

Sub update_directory()


Dim cTemp As Range
Set cTemp = ActiveSheet.Range("AA1")

Dim arrSheetNames As Variant
With cTemp
    .Formula2 = "=TRANSPOSE(SheetNames)"
    arrSheetNames = .CurrentRegion.Value   'read values of formula reulst to an array
    .Clear   'we don't need that anylonger
End With

Dim lo As ListObject
Set lo = ActiveSheet.ListObjects(1)   'this is the reference to your table

With lo
    With .ListColumns("Sheets")
        'clear Sheets-column
        If Not .DataBodyRange Is Nothing Then
            .DataBodyRange.Clear
        Else
            lo.ListRows.Add
        End If
        
        'insert arrSheetNames to sheets-column (as values)
        .DataBodyRange.Resize(UBound(arrSheetNames, 1), 1).Value = arrSheetNames
        
    End With
    'resize listobject/table according to size of arrSheetnames   1 for header row
    .Resize .Range.Resize(UBound(arrSheetNames, 1)   1, 2)
End With
    
End Sub