0 votes
in VBA by Expert (916 points)

Hello everyone

 

I have multiple tables each in one sheet .. say Sheet1 and Sheet2 and Sheet3 have three tables

The tables are of course with the same structure

How can I store all the non-empty data into one array ..?

 

I am using such a code to store just one table

Sub Test()
    Dim ws As Worksheet, rng As Range, a

    Set ws = ThisWorkbook.Worksheets(2)

    Set rng = ws.ListObjects(1).DataBodyRange
    a = Intersect(rng, rng.Offset(0, 1)).Value

End Sub



 

Thanks advnaced for help

by Expert (916 points)
Any help in this topic please?

1 Answer

+1 vote
by Super Expert (3.2k points)
selected by
 
Best answer

If the tables aren't touching, you'll need to write a UDF to combine the tables into a consolidated 2D array. Here's an example that stores all the tables on a particular sheet to an array and combines them. The tables must have the same number of columns Instead of reinventing the wheel, this macro uses a 2D combination function I found here.

Sub CombineTables()
    Dim ws As Worksheet, rng As Range
    Dim arrCombined As Variant, a As Variant
    Dim tbl As ListObject
    Dim i As Integer

    Set ws = ThisWorkbook.Worksheets(2)
    For Each tbl In ws.ListObjects
        i = i + 1
        Set rng = tbl.DataBodyRange
        a = Intersect(rng, rng.Offset(0, 1)).Value
        
        If i = 1 Then
            arrCombined = a
        Else
            arrCombined = Combine(arrCombined, a, True)
        End If
    Next tbl
End Sub

Function Combine(a As Variant, B As Variant, Optional stacked As Boolean = True) As Variant
    'assumes that A and B are 2-dimensional variant arrays
    'if stacked is true then A is placed on top of B
    'in this case the number of rows must be the same,
    'otherwise they are placed side by side A|B
    'in which case the number of columns are the same
    'LBound can be anything but is assumed to be
    'the same for A and B (in both dimensions)
    'False is returned if a clash

    Dim lb As Long, m_A As Long, n_A As Long
    Dim m_B As Long, n_B As Long
    Dim m As Long, n As Long
    Dim i As Long, j As Long, k As Long
    Dim C As Variant

    If TypeName(a) = "Range" Then a = a.Value
    If TypeName(B) = "Range" Then B = B.Value

    lb = LBound(a, 1)
    m_A = UBound(a, 1)
    n_A = UBound(a, 2)
    m_B = UBound(B, 1)
    n_B = UBound(B, 2)

    If stacked Then
        m = m_A + m_B + 1 - lb
        n = n_A
        If n_B <> n Then
            Combine = False
            Exit Function
        End If
    Else
        m = m_A
        If m_B <> m Then
            Combine = False
            Exit Function
        End If
        n = n_A + n_B + 1 - lb
    End If
    ReDim C(lb To m, lb To n)
    For i = lb To m
        For j = lb To n
            If stacked Then
                If i <= m_A Then
                    C(i, j) = a(i, j)
                Else
                    C(i, j) = B(lb + i - m_A - 1, j)
                End If
            Else
                If j <= n_A Then
                    C(i, j) = a(i, j)
                Else
                    C(i, j) = B(i, lb + j - n_A - 1)
                End If
            End If
        Next j
    Next i
    Combine = C
End Function

I couldn't tell by the question if you wanted to combine all the tables on each sheet or combine matching tables across each sheet (i.e., combine Table 1 on Sheet 1 with Table 1 on Sheet etc.). The above routine does the former. You'll need to modify the looping routine to loop through the sheets and tables if the latter is what you wanted.

by Expert (916 points)

That's wonderful

I have used the code like that

Sub CombineTables()
    Dim arrCombined, a, ws As Worksheet, rng As Range, tbl As ListObject, i As Long

    For Each ws In ThisWorkbook.Worksheets(Array("Jan", "Feb", "Mar"))
    For Each tbl In ws.ListObjects
        i = i + 1
        Set rng = tbl.DataBodyRange
        a = Intersect(rng, rng.Offset(0, 1)).Value
        
        If i = 1 Then
            arrCombined = a
        Else
            arrCombined = Combine(arrCombined, a, True)
        End If
    Next tbl
    Next ws
End Sub

But the array has empty rows .. How can I skip storing the empty rows in those tables?

by Super Expert (3.2k points)
+1

To skip blank rows, you'll need to loop through each row individually instead of adding the entire databodyrange at once. Here's how you would do it:

Sub CombineTables()
    Dim arrCombined, a, ws As Worksheet, rng As Range, tbl As ListObject, i As Long

    For Each ws In ThisWorkbook.Worksheets(Array("Jan", "Feb", "Mar"))
        For Each tbl In ws.ListObjects
            Set rng = tbl.DataBodyRange
            For Each lrow In rng.Rows
                If WorksheetFunction.CountA(lrow) > 0 Then
                    i = i + 1
                    a = lrow.Value
                    If i = 1 Then
                        arrCombined = a
                    Else
                        arrCombined = Combine(arrCombined, a, True)
                    End If
                End If
            Next lrow
        Next tbl
    Next ws
End Sub

'MUST STILL INCLUDE THE Combine FUNCTION IN THE ORIGINAL ANSWER

This routine doesn't add a row to the table if the entire row of data is empty. I hope this helps!

by Expert (916 points)
+1
Thank you very much for awesome help.

Welcome to wellsr Q&A
Ask any questions you have about VBA and Python and our community will help answer them. wellsr Q&A is the standalone question and answer platform for wellsr.com. If you have a question about one of our specific tutorials, please include a link back to the tutorial.

Getting Started
Register
VBA Cheat Sheets (On Sale Now)

Looking for something else? Hire our team directly through ourVBA Help page, instead.

For more programming tips visit the VBA Tutorials Blog and the Python Tutorials Blog.

...