Consolidate/Append/Stack Multiple Named Tables

[ShelleyBelly]

Hi All,

I have multiple names tables (Track_01, Track_02, Track_03 ... and so on) they are all in the same workbook and all have an identical column structure.

I have been able to find the solution for stacking two data bodies but not three or more. The end result should be a table named "body" which is always present and has an identical structure, but that at the execution of a macro will clear and then re populate with the contents of about 20 tracks. The tracks may or may not have data but should be stacked sequentially without any blank rows.

I scoured the internet and to date have not found any solution for stacking multiple tables

Thanks to all in advance,

Tom

 

[igold]

Hi Tom,

See if this gets you close to your requirements.

Please test on a backup copy of your worksheet as this code will delete data that is not recoverable.

Sub StackTables()


    Dim tbl As ListObject, btbl As ListObject, trtbl As ListObject
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim sh As Worksheet
    Dim tct As Integer, lon As Integer, tracks As Integer, trNum As Integer, x As Integer, botlr As Integer
    Dim TrackName As String
    
    Application.ScreenUpdating = False
    tracks = InputBox("Please Enter the Number of Tables To Be Stacked")
    For Each sh In wb.Worksheets
        tct = sh.ListObjects.Count
        If tct > 0 Then
            For lon = 1 To tct
                If sh.ListObjects(lon).Name = "body" Then
                    Set btbl = sh.ListObjects("body")
                    If btbl.ListRows.Count >= 1 Then
                        btbl.DataBodyRange.Delete
                    End If
                End If
            Next
        End If
    Next
    For trNum = 1 To tracks
        TrackName = "Track_" & Format(trNum, "00")
        For Each sh In wb.Worksheets
            tct = sh.ListObjects.Count
            If tct > 0 Then
                For lon = 1 To tct
                    If sh.ListObjects(lon).Name = TrackName Then
                        Set trtbl = sh.ListObjects(TrackName)
                        If trtbl.ListRows.Count >= 1 Then
                            For x = 1 To trtbl.Range.Rows.Count - 1
                                btbl.ListRows.Add alwaysinsert:=True
                                trtbl.ListRows(x).Range.Copy
                                botlr = btbl.Range.Rows.Count
                                btbl.Range.Rows(botlr).PasteSpecial
                            Next
                        End If
                    End If
                Next
            End If
        Next
    Next
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    
End Sub

I hope this helps...

igold

 

[ShelleyBelly]

Hi Igold

First of all thank you, this does the trick. However I'd like to remove the human interface part and have it stack all "track_xx" . I fear a user would only make a mess!

Thanks in advance

Tom

 

[igold]

Hi Tom,

Made a change so that the code will look sequentially for a maximum of 100 tracks. If you have more than that, I made a notation on where you can change that number. Conversely you can lower it if you would like, which may speed the code a little but unless your workbook has a lot of worksheets the time difference to run the code should be imperceptible. Additionally, Track numbers between 1-9 should have a leading zero i.e 01, 02, 03, etc, but anything above 09 should be not have a leading zero such as Track_15 would be valid, while Track_015 would not work.

Sub StackTables()


    Dim tbl As ListObject, btbl As ListObject, trtbl As ListObject
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim sh As Worksheet
    Dim tct As Integer, lon As Integer, Tracks As Integer, _
    trNum As Integer, x As Integer, botlr As Integer, fnd As Integer
    Dim TrackName As String
    
    Application.ScreenUpdating = False
    Tracks = 100 '************Change Maximum Number of Tracks Here
    For Each sh In wb.Worksheets
        tct = 0
        tct = sh.ListObjects.Count
        If tct > 0 Then
            For lon = 1 To tct
                If sh.ListObjects(lon).Name = "body" Then
                    fnd = 1
                    Set btbl = sh.ListObjects("body")
                    If btbl.ListRows.Count >= 1 Then
                        btbl.DataBodyRange.Delete
                    End If
                End If
            Next
        End If
        If fnd = 1 Then Exit For
    Next
    For trNum = 1 To Tracks
        TrackName = "Track_" & Format(trNum, "00")
        For Each sh In wb.Worksheets
            tct = 0
            tct = sh.ListObjects.Count
            If tct > 0 Then
                For lon = 1 To tct
                    If sh.ListObjects(lon).Name = TrackName Then
                        Set trtbl = sh.ListObjects(TrackName)
                        If trtbl.ListRows.Count >= 1 Then
                            For x = 1 To trtbl.Range.Rows.Count - 1
                                btbl.ListRows.Add alwaysinsert:=True
                                trtbl.ListRows(x).Range.Copy
                                botlr = btbl.Range.Rows.Count
                                btbl.Range.Rows(botlr).PasteSpecial
                            Next
                        End If
                        GoTo NextTrack
                    End If
                Next
            End If
        Next
NextTrack:
    Next
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    
End Sub

Happy Holidays!

igold

 

[Rick Rothstein]

Hi All,

I have multiple names tables (Track_01, Track_02, Track_03 ... and so on) they are all in the same workbook and all have an identical column structure.

The end result should be a table named "body" which is always present

You named tables... they are real Excel tables and not just ranges which you named that way, correct?

Are all the Track_## tables on the same worksheet? If so, what is the name of that worksheet?

What is the name of the worksheet that the Body table is on?

 

[ShelleyBelly]

Hi Igold,

Long time no speak, i'm afraid I was away from my computer and couldn't say thank you... thank you!

It does the trick perfectly.

Thanks,

Tom

 

[igold]

Hi Tom,

No problem. A delayed response is better than no response at all. I was happy to help and glad it worked for you. Thanks for the feedback.

igold