Making one Array composed of multiple range values from different sheets in Excel VBA

Question

I'm trying to create an array of values which I obtain from x many sheets that a data spreadsheet has.

Currently this is what I have so far


Sub Test()

Workbooks.Open("dataex.xlsx").Activate
Dim i, x, y, z, sheet_num

Dim allsheets As Variant

Dim sheet As Variant
Dim sheets As Variant '

Dim list As Variant

Dim ws As Worksheet
i = Application.sheets.Count

x = 1
ReDim allsheets(1 To i)

For Each ws In Worksheets
    allsheets(x) = ws.Name
    x = x + 1
Next ws

sheets = allsheets
For Each sheet In sheets

tmp = Range("A2").CurrentRegion.Value

y = Range("A1").CurrentRegion.Rows.Count
z = Range("A1").CurrentRegion.Columns.Count

list = Range(Cells(1, 1), Cells(y, z))

Next sheet

End Sub

I have attached a picture to show the the fake data I created (same data on each sheet for simplicity)

At the end I would like to get an array named list to be the same number of z columns but the rows of the values would be added underneath each other and then to resize the array and add the sheet it is from.

Tim Williams · Accepted Answer · 2020-01-18 00:18:10Z

1

I've done something similar before and it looked like this:

Sub Test()

    Dim i As Long, wb As Workbook, data(), numSheets As Long
    Dim rng As Range, numCol As Long, totRows As Long, allData()
    Dim rw As Long, col As Long, arr, r As Long, firstSheet As Boolean

    Set wb = Workbooks.Open("dataex.xlsx")
    numSheets = wb.Worksheets.Count

    ReDim data(1 To numSheets)
    firstSheet = True 'controls whether we skip the header row

    'loop over the sheets and collect the data
    For i = 1 To numSheets
        Set rng = wb.Worksheets(i).Range("A1").CurrentRegion
        'ignore empty sheets
        If Application.CountA(rng) > 0 Then
            'remove the header if not first sheet
            If Not firstSheet Then Set rng = rng.Offset(1, 0).Resize(rng.Rows.Count - 1)
            data(i) = rng.Value                     'collect the data
            totRows = totRows + UBound(data(i), 1)  'add the row count
            firstSheet = False 'done one sheet
        End If
    Next i

    'size the final output array
    ReDim allData(1 To totRows, 1 To UBound(data(1), 1))

    r = 1
    'combine the array from each sheet into the final array
    For i = 1 To numSheets
        If Not IsEmpty(data(i)) Then 'sheet had data?
            arr = data(i)
            For rw = 1 To UBound(arr, 1)
                For col = 1 To UBound(arr, 2)
                    allData(r, col) = arr(rw, col)
                Next col
                r = r + 1
            Next rw
        End If
    Next i

    'add a new sheet and dump the array
    With wb.sheets.Add(after:=wb.sheets(wb.sheets.Count))
        .Range("A1").Resize(totRows, UBound(allData, 2)).Value = allData
    End With

End Sub

answered Jan 18, 2020 at 0:18

Tim Williams

169k8 gold badges104 silver badges143 bronze badges

Sign up to request clarification or add additional context in comments.

2 Comments

TheNerdyMinded Over a year ago

Thanks! that was a big help. My only other question is when combining the array part, I get an out of range error at line ''alldata(r,col)=arr(rw,col)'' because "col" ends up being out of range. how do I fix that? sorry new to coding.

TheNerdyMinded Over a year ago

never mind, It was that Ubound needed to be set to data(2),2)

Collectives™ on Stack Overflow

Making one Array composed of multiple range values from different sheets in Excel VBA

1 Answer 1

2 Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

2 Comments

Your Answer

Sign up or log in

Post as a guest

Related