Add multiple range to a 2 dimensional array

[ashish128]

Dear All,

Am trying to write VBA code to make a 2 dimensional array from different ranges but unable to properly insert second and next ranges.

My ranges are on Col A to Col H on each sheet with possibility of different total number of rows on different sheets.

Sub ticker()
'
' ticker Macro
' This macro will consider all Sheets

'
    Dim thisWB As Workbook
    Dim thisWS As Worksheet
    Dim lastrow As Long
    Dim tickerArray As Variant
    
    Set thisWB = ActiveWorkbook
    counter = 1
    For Each thisWS In thisWB.Worksheets
        
        lastrow = thisWS.Cells(thisWS.Rows.Count, 1).End(xlUp).Row
        'Add data to array
        If counter = 1 Then
            ReDim tickerArray(1 To lastrow - 1, 1 To 8)
            tickerArray = thisWS.Range("A2:H" & lastrow)
            
            
        Else
            
            tickerArray = Application.Transpose(tickerArray)
            ReDim Preserve tickerArray(1 To 8, 1 To UBound(tickerArray, 2) + lastrow - 1)
            tickerArray = Application.Transpose(tickerArray)
            'Am not able to append the range to array below. the current code in below line replaces the array values
            tickerArray = thisWS.Range("A2:H" & lastrow)
            
        End If
        
        counter = counter + 1
    Next thisWS
    
End Sub

Data on each sheet looks like below

<ticker>	<date>	<open>	<high>	<low>	<close>	<vol>	Calculate
AAB	20200102	23.43​	23.57​	23.43​	23.57​	28522​
AAB	20200103	23.52​	23.61​	23.43​	23.44​	1399​
AAB	20200106	23.46​	23.48​	23.37​	23.39​	2953​
AAB	20200107	23.31​	23.47​	23.28​	23.47​	64755​

Could you please guide me as to where should I correct my code?
I know I need to insert second range after the first range but am unable to make a code for it.

Best Regards
Ashish

 

[kevin9999]

I'm a bit late to the party on this one, but I thought I'd put in my 2 cents' worth. Based on your comment in post #8

Am looking for a solution where am not required to loop individual through cells and can directly append a range to a 2D array.

I believe this may come closer to what you are looking for. It does load ranges into an input array, before looping through to populate an output array. Shout out to @johnnyL for This solution which gave me the underlying concept.

Assumes you have a workbook of 4 sheets, with the first 3 having a data layout as per post #5 (although of various lengths), and that you want the consolidation put onto sheet 4.

Option Explicit
Sub Append_Array()

    '1  Set the sheets variables
    Dim ws As Worksheet, ws2 As String
    ws2 = "Sheet4"  '<<< change to suit
    
    '2  Set the dimensions of the input array
    Dim TotSheets As Long
    TotSheets = ThisWorkbook.Worksheets.Count - 1   '<<< -1 to exclude counting the results sheet
    Dim ArrIn
    ReDim ArrIn(1 To TotSheets)
    
    '3  Add each sheets' data to the input array
    '   (plus count the total rows to be appended)
    '   This is the bit that 'appends' data 'blocks'
    Dim i As Long, LRow As Long, TotRows As Long
    For i = 1 To ThisWorkbook.Worksheets.Count
        If Sheets(i).Name <> ws2 Then
            LRow = Sheets(i).Cells.Find("*", , xlFormulas, , 1, 2).Row
            ArrIn(i) = Sheets(i).Cells(1, 1).Offset(1).Resize(LRow - 1, 8)
            TotRows = TotRows + UBound(ArrIn(i), 1)
        End If
    Next i
    
    '4  Define and return the data into the output array
    Dim r As Long, rw As Long, col As Long, arr
    ReDim ArrOut(1 To TotRows, 1 To 8)
    r = 1
    For i = 1 To TotSheets
        arr = ArrIn(i)
        For rw = 1 To UBound(arr, 1)
            For col = 1 To UBound(arr, 2)
                ArrOut(r, col) = arr(rw, col)
                Next col
                r = r + 1
        Next rw
    Next i
    
    '5  Add the column titles and return the output array to sheet4
    Sheet1.Range("A1:H1").Copy Worksheets(ws2).Range("A1")
    Worksheets(ws2).Range("A2").Resize(TotRows, 8).Value = ArrOut

End Sub

 

[johnnyL]

Somebody mentioned my name?

...
Am looking for a solution where am not required to loop individual through cells and can directly append a range to a 2D array.

@ashish128 I haven't found a way that you can directly append an array to another array.

You could use the approach that @kevin9999 suggested which copies the arrays to another array via looping through memory, as opposed to looping through the cells in a sheet. This looping in memory is way faster than than looping through sheet data.

Another approach, which I will provide the code for, is to copy the arrays to a worksheet and then read the data back into an array. This approach does not involve 'looping through cells', in fact there is no looping at all.

The code allows you to combine any two 2D arrays together. Well I suppose there could be a maximum column width, but most likely that will not be an issue.
The code allows you to arrange the two arrays vertically or horizontally.

Sample Data:

Combining Arrays.xlsm
	A	B	C	D	E	F	G	H	I
1	A1	B1	C1
2	A2	B2	C2	D2		F2	G2	H2
3	A3		C3			F3		H3
4	A4	B4	C4	D4
5
Sheet1

Sample subroutine to call the function:

Sub Combine2D_Arrays()
'
    Dim ArrayToAdd              As Variant, InputArray  As Variant
    Dim NewInputArray           As Variant
    Dim wsInput                 As Worksheet
'
    Set wsInput = Sheets("Sheet1")                                                                          ' <--- Set this to the sheet name desired
'
    InputArray = wsInput.Range("A1:D4")                                                                     ' Create first array
    ArrayToAdd = wsInput.Range("F2:H3")                                                                     ' Create second array
'
    NewInputArray = CombinedArray(InputArray, ArrayToAdd)                                                   ' Call function to combine the two arrays ... Add ', True' to the end for Horizontal combining
'
    wsInput.Range("M1").Resize(UBound(NewInputArray, 1), UBound(NewInputArray, 2)).Value = NewInputArray    ' Display the combined array
End Sub

Function that combines the two 2D arrays:

Function CombinedArray(Array1, Array2, Optional Horizontal As Boolean)
'
'   This function accepts two 2D array names as arguments & will accept an optional 3rd argument for Horizontal (side by side) array arrangement.
'   This function will write both arrays to a temporary worksheet, then save the data to an array, then delete the temporary worksheet.
'   This function varies from other functions I have seen posted, in that the column sizes, as well as the row sizes, of the two arrays do not have to be the same size.
'
'   Example usage:
'       CombinedArray(Array1, Array2)                   -- this will create a 2D 1 Based array with first array on top of the second array.
'       CombinedArray(Array1, Array2, False)            -- this also will create a 2D 1 Based array with first array on top of the second array.
'       CombinedArray(Array1, Array2, True)             -- this will create a 2D 1 Based array with first array arranged to the left of the second array.
'
    Dim ArrayRows       As Long
    Dim ArrayColumns    As Long
'
    Application.ScreenUpdating = False                                                                      ' Turn ScreenUpdating off
'
    With Worksheets.Add                                                                                     ' Add a temporary worksheet to the workbook
        If Horizontal = False Then                                                                          '   If desired array arangement is to 'stack' them then ..
            .Range("A1").Resize(UBound(Array1, 1), UBound(Array1, 2)) = Array1                              '       Write the first array to the temporary worksheet
            .Range("A1").Resize(UBound(Array2, 1), UBound(Array2, 2)).Offset(UBound(Array1, 1)) = Array2    '       Write the second array to the temporary worksheet below the first array
'
            ArrayColumns = Application.WorksheetFunction.Max(UBound(Array1, 2), UBound(Array2, 2))          '       Set the Combined array column size to the maximum column size of either Array1 or Array2
            ArrayRows = UBound(Array1, 1) + UBound(Array2, 1)                                               '       Set the Combined array row size to the total # of rows in Array1 & Array2
        Else                                                                                                '   Else ...
            .Range("A1").Resize(UBound(Array1, 1), UBound(Array1, 2)) = Array1                          '           Write the first array to the temporary worksheet
            .Range("A1").Resize(UBound(Array2, 1), UBound(Array2, 2)).Offset(0, UBound(Array1, 2)) = Array2 '       Write the second array to the temporary worksheet beside the first array
'
            ArrayColumns = UBound(Array1, 2) + UBound(Array2, 2)                                            '       Set the Combined array column size to the total # of columns in Array1 & Array2
            ArrayRows = Application.WorksheetFunction.Max(UBound(Array1, 1), UBound(Array2, 1))             '       Set the Combined array row size to the maximum row size of either Array1 or Array2
        End If
'
        CombinedArray = .Range("A1").Resize(ArrayRows, ArrayColumns)                                        '   Save the combined data to 2D 1 Based CombinedArray
'
        Application.DisplayAlerts = False                                                                   '   Turn DisplayAlerts off
        .Delete                                                                                             '   Delete the temporary worksheet
        Application.DisplayAlerts = True                                                                    '   Turn DisplayAlerts back on
        Application.ScreenUpdating = True                                                                   '   Turn ScreenUpdating back on
    End With
End Function

Test that and let me know what you think.