Stacking several ranges into a dynamic array

Question

Hopefully i've phrased that right...

I came across something online stating that copy and pasting wastes precious time. It's better to assign values more directly, without using excel functions.

I found a section in a VBA book explaining how to store a range in a 2D array.

Now what if I wanted to copy and paste a range from a dynamic number of worksheets into another one main sheet with this method?

In my head, I imagine stacking more and more values into an array, then dumping the array where I'd like it to go, into a range whose size is defined by the dimensions of the big array.

In practice, all I have managed to create is something like the below, performing the same simple action for each worksheet in turn.

Is it possible to do this better? That runs faster? Help a brother out!

Sub arrayCopyPaste()

Dim Obj As Range
Dim Data As Variant
Dim ws As Worksheet
Dim sheetCount As Integer
Dim LR As Integer

sheetCount = Sheets.Count

Set ws = Sheets.Add
ws.Move After:=Worksheets(Worksheets.Count)

For i = 1 To sheetCount
    Data = Sheets(i).Range("A1:B9")
    LR = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    Set Obj = ws.Range("A" & LR)
    Set Obj = Obj.Resize(UBound(Data, 1), UBound(Data, 2))
    Obj.Value = Data
Next i
End Sub

Answer 1

This version is slightly more efficient due to writing the results all at once, though you probably won't notice much of a difference unless you're working with very large ranges.

Sub test()

    'Same as original: final array is 2 columns wide, (3 * number of sheets) rows long
    Call mergeRangeValues("A1:B3", "Results", True)

    'Alternate version: final array is 3 rows long, (2 * number of sheets) columns wide
    'Call mergeRangeValues("A1:B3", "Results", False)

End Sub
Sub mergeRangeValues(rngString As String, newWSName As String, stackRows As Boolean)
'Merges the same range (rngString) from all sheets in a workbook
'Adds them to a new worksheet (newWSName)
'If stackRows = True, values are stacked vertically
'If stackRows = False, values are stacked horizontally

    Dim sheetCount As Long
    Dim newWS As Worksheet
    sheetCount = ThisWorkbook.Sheets.Count
    Set newWS = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(sheetCount))
    newWS.Name = newWSName

    Dim numCols As Long
    Dim numRows As Long
    numCols = newWS.Range(rngString).Columns.Count * IIf(stackRows, 1, sheetCount)
    numRows = newWS.Range(rngString).Rows.Count * IIf(stackRows, sheetCount, 1)
    ReDim resultsArr(1 To numRows, 1 To numCols) As Variant
    '''Longer version:
    'If stackRows Then
        'numCols = newWS.Range(rngString).Columns.Count
        'numRows = newWS.Range(rngString).Rows.Count * sheetCount
    'Else
        'numCols = newWS.Range(rngString).Columns.Count * sheetCount
        'numRows = newWS.Range(rngString).Rows.Count
    'End If
    '''ie "If you want to stack the results vertically, make the array really long"
    '''or "If you want to stack the results horizontally, make the array really wide"

    Dim i As Long
    For i = 0 To sheetCount - 1
        Dim tempArr As Variant
        tempArr = ThisWorkbook.Sheets(i + 1).Range(rngString).Value
        Dim j As Long
        Dim k As Long
        If stackRows Then
            For j = LBound(tempArr, 1) To UBound(tempArr, 1)
                For k = LBound(tempArr, 2) To UBound(tempArr, 2)
                    resultsArr(j + i * (numRows / sheetCount), k) = tempArr(j, k)
                Next
            Next
        Else
            For j = LBound(tempArr, 1) To UBound(tempArr, 1)
                For k = LBound(tempArr, 2) To UBound(tempArr, 2)
                    resultsArr(j, k + i * (numCols / sheetCount)) = tempArr(j, k)
                Next
            Next
        End If
    Next

    With newWS
        .Range(.Cells(1, 1), .Cells(numRows, numCols)).Value = resultsArr
    End With

End Sub

Answer 2

I'd be inclined to use your current approach and just boil it down a bit.

Sub arrayCopyPaste()

    Dim ws As Worksheet

    Set ws = Sheets.Add(After:=Worksheets(Worksheets.Count))

    For i = 1 To Sheets.Count - 1
        With Sheets(i).Range("A1:B9")
            ws.Cells(ws.Rows.Count, 1).End(xlUp).Offset(1, 0).Resize( _
                        .Rows.Count, .Columns.Count).Value = .Value
        End With
    Next i

End Sub

Answer 3

With just about any code I use, I like to make a call to this routine I made:

Sub SpeedupCode(Optional ByVal Val As Boolean = True)

    With Application
        If Val = True Then
            .ScreenUpdating = False
            .Calculation = xlCalculationManual
        Else
            .ScreenUpdating = True
            .Calculation = xlCalculationAutomatic
        End If
    End With

End Sub

So, in your code you would simply use it as follows:

Sub arrayCopyPaste()

    Dim Obj As Range
    Dim Data As Variant
    Dim ws As Worksheet
    Dim sheetCount As Integer
    Dim LR As Integer

    SpeedupCode

    sheetCount = Sheets.Count

    Set ws = Sheets.Add
    ws.Move After:=Worksheets(Worksheets.Count)

    For i = 1 To sheetCount
        Data = Sheets(i).Range("A1:B9")
        LR = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
        Set Obj = ws.Range("A" & LR)
        Set Obj = Obj.Resize(UBound(Data, 1), UBound(Data, 2))
        Obj.Value = Data
    Next i

    SpeedupCode False

End Sub

While this does not necessarily optimize your code, it can significantly improve the performance on every project that you do. In the event that your code requires a newly calculated variable in your worksheet, you can always use Application.Calculate before you grab that variable, but generally, it shouldn't be needed.