Loop through sheets and resize table on each sheet.

[Darranimo]

I have a script that takes data from a parent worksheet (data import) and distributes it to the appropriate child worksheets. Each of those worksheets contains the same table just with different data. Here is the script that places the new data at the end of each respective table.

Sub Dispatch()
rng = shtWF.Cells(1, 1).CurrentRegion

On Error Resume Next
For rw = 1 To UBound(rng)
    rRng = Right(rng(rw, 6), 4)
    Sheets(rRng).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, UBound(rng)).Value = shtWF.Cells(rw, 1).Resize(1, UBound(rng)).Value
Next rw
On Error GoTo 0

End Sub

The above code works beautifully to add the new data to the bottom of each sheet's table as seen here:

What I would like to do is then loop through the sheets containing tables and resize them to encompass the new data. Here is my attempt at that code:

Sub TblResize()
Dim i As Integer
Dim tbl As ListObject
Dim lrw As Long

lrw = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row

For i = 1 To Worksheets.Count - 2
    For Each tbl In ActiveSheet.ListObjects
        tbl.Resize Range("A3", "t" & lrw)
    Next
Next i
End Sub

This code works, but only on the active sheet. Clearly looping through the sheets does not make them active and that is my hang up. How do I get this to run on all the worksheets except the last two? Ideally, I think it would be nice if all of this could be accomplished in one macro. Any help is appreciated. Thank you in advance!

 

[Domenic]

Your table should automatically adjust as you copy your values to the next row below your table. Is this not the case? In any case, to make your code work, you would need to amend it as follows . . .

Sub TblResize()
    Dim i As Integer
    Dim tbl As ListObject
    Dim lrw As Long
    
    For i = 1 To Worksheets.Count - 2
        With Worksheets(i)
            For Each tbl In .ListObjects
                lrw = .Cells(.Rows.Count, "A").End(xlUp).Row
                tbl.Resize .Range("A3", "t" & lrw)
            Next
        End With
    Next i

Actually, you could replace . . .

lrw = .Cells(.Rows.Count, "A").End(xlUp).Row
tbl.Resize .Range("A3", "t" & lrw)

with

tbl.Resize .Range("A3").CurrentRegion

Hope this helps!

 

[Jon Peltier]

Does the Table expand automatically when you manually add data? If not, this should solve the problem without messing with any code. Go to File > Options > Proofing > AutoFormat As You Type > Include New Rows And Columns In Table.

I have no idea why it's hidden in Proofing.

 

[Darranimo]

Does the Table expand automatically when you manually add data? If not, this should solve the problem without messing with any code. Go to File > Options > Proofing > AutoFormat As You Type > Include New Rows And Columns In Table.

I have no idea why it's hidden in Proofing.

That's what is weird. It updates perfectly when I manually type on the next line but not when Dispatch() is run.

 

[Jon Peltier]

What error is the On Error protecting you from? You must not have Option Explicit at the top of the module, because you have declared no variables. I presume

Sheets(rRng).Cells(Rows.Count, 1)

should be

Sheets(rRng).Cells(Sheets(rRng).Rows.Count, 1)

I don't think these things should be preventing the Tables from automatically updating, but if there is some error that is being ignored, perhaps it fires between adding the rows and adjusting the Table.

 

[Darranimo]

What error is the On Error protecting you from? You must not have Option Explicit at the top of the module, because you have declared no variables. I presume

Sheets(rRng).Cells(Rows.Count, 1)

should be

Sheets(rRng).Cells(Sheets(rRng).Rows.Count, 1)

I don't think these things should be preventing the Tables from automatically updating, but if there is some error that is being ignored, perhaps it fires between adding the rows and adjusting the Table.

The error is subscript out of range. It errors out when no data is found for one of the worksheets. The on error allows the script to continue checking the rest of the data.

 

[Darranimo]

Your table should automatically adjust as you copy your values to the next row below your table. Is this not the case? In any case, to make your code work, you would need to amend it as follows . . .

Sub TblResize()
    Dim i As Integer
    Dim tbl As ListObject
    Dim lrw As Long
   
    For i = 1 To Worksheets.Count - 2
        With Worksheets(i)
            For Each tbl In .ListObjects
                lrw = .Cells(.Rows.Count, "A").End(xlUp).Row
                tbl.Resize .Range("A3", "t" & lrw)
            Next
        End With
    Next i

Actually, you could replace . . .

lrw = .Cells(.Rows.Count, "A").End(xlUp).Row
tbl.Resize .Range("A3", "t" & lrw)

with

tbl.Resize .Range("A3").CurrentRegion

Hope this helps!

For some reason it doesn't automatically expand the table. But your suggestions worked perfectly! Thank you

Your table should automatically adjust as you copy your values to the next row below your table. Is this not the case? In any case, to make your code work, you would need to amend it as follows . . .

Sub TblResize()
    Dim i As Integer
    Dim tbl As ListObject
    Dim lrw As Long
   
    For i = 1 To Worksheets.Count - 2
        With Worksheets(i)
            For Each tbl In .ListObjects
                lrw = .Cells(.Rows.Count, "A").End(xlUp).Row
                tbl.Resize .Range("A3", "t" & lrw)
            Next
        End With
    Next i

Actually, you could replace . . .

lrw = .Cells(.Rows.Count, "A").End(xlUp).Row
tbl.Resize .Range("A3", "t" & lrw)

with

tbl.Resize .Range("A3").CurrentRegion

Hope this helps!

Your suggestions worked perfectly!! Thank you Domenic!