Add local array to public array - loop redim preserve

[GeeWhiz7]

Hi,
I have a loop that used to get arrays from individual worksheets and then combine and write out to one worksheet.
I'm trying to get better at dealing with arrays and avoiding repeated read/write to worksheets...sufficed to say, its still a struggle.

Goal: Take each array that populated via a loop at the Sub level and append it to a global(?) or module level array that is redim'd preserved until final iteration and then the big array is written out.

Not sure I have a great example, but here is what I am experimenting with to try to figure out. It isn't a loop which I will need to get to, but at the first stage I was just trying to figure out how to append data into the big array.
Any help showing me how to 1) get individual arrays into big one and 2) do that with a loop that gets each array is greatly appreciated!

Option Explicit
Public AllArray() As Variant  'Would like this array to hold all arrays.

Sub Test()

Dim ws As Worksheet
Dim Array1, Array2, Array3 As Variant

Set ws = Worksheets("Sheet1")

'####Technically I would have a loop here something like
'####For each ws in wsnames
'####Array = ws.Range("A1").CurrentRegion.Value
'####noting that row counts are always the same in each array, so only columns need to get added
'####starting location is also always the same (A1) on each sheet the loop accesses

Array1 = ws.Range("A1").CurrentRegion.Value
Array2 = ws.Range("A8").CurrentRegion.Value
Array3 = ws.Range("A15").CurrentRegion.Value

ReDim AllArray(1 To UBound(Array1, 1), 1 To UBound(Array1, 2))

AllArray = Array1

ReDim Preserve AllArray(1 To UBound(AllArray, 1), 1 To (UBound(Array1, 2) + (UBound(Array2, 2))))

' AllArray = ?  This is first place I'm lost.

End Sub

Visually represented...

Book3
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P
1	Item	Color	Size				Item	Color	Size	Item	Color	Size	Item	Color	Size
2	1	Red	M				1	Red	M	1	Pink	S	1	Yellow	XL
3	2	Red	XL		Array 1		2	Red	XL	2	Red	S	2	Green	L
4	3	Blue	S				3	Blue	S	3	Green	M	3	Blue	XXL
5	4	Green	S				4	Green	S	4	Orange	XL	4	Blue	M
6	5	Yellow	M				5	Yellow	M	5	Red	L	5	Blue	M
7
8	Item	Color	Size				Array 1			Array 2			Array 3
9	1	Pink	S
10	2	Red	S		Array 2					Desired Result in one array
11	3	Green	M
12	4	Orange	XL
13	5	Red	L
14
15	Item	Color	Size
16	1	Yellow	XL
17	2	Green	L		Array 3
18	3	Blue	XXL
19	4	Blue	M
20	5	Blue	M
21
Sheet1

 

[offthelip]

try this:

Option Explicit
Public AllArray() As Variant  'Would like this array to hold all arrays.

Sub Test()
Dim totcol, i, j
Dim ws As Worksheet
Dim Array1, Array2, Array3 As Variant

Set ws = Worksheets("Sheet1")

'####Technically I would have a loop here something like
'####For each ws in wsnames
'####Array = ws.Range("A1").CurrentRegion.Value
'####noting that row counts are always the same in each array, so only columns need to get added
'####starting location is also always the same (A1) on each sheet the loop accesses

Array1 = ws.Range("A1").CurrentRegion.Value
Array2 = ws.Range("A8").CurrentRegion.Value
Array3 = ws.Range("A15").CurrentRegion.Value

' Find total number of columns needed . Note it is better to define the array the correct size to start with since it is faster than using preserve
totcol = UBound(Array1, 2) + UBound(Array2, 2) + UBound(Array2, 2)

ReDim AllArray(1 To UBound(Array1, 1), 1 To totcol)
For i = 1 To UBound(Array1, 1)
 For j = 1 To UBound(Array1, 2)
  AllArray(i, j) = Array1(i, j)
 Next j
 ' note if all the arrays have the same number of columns then this could be simplifed
 For j = 1 To UBound(Array2, 2)
  AllArray(i, j + UBound(Array1, 2)) = Array2(i, j)
 Next j
 For j = 1 To UBound(Array3, 2)
  AllArray(i, j + UBound(Array1, 2) + UBound(Array2, 2)) = Array3(i, j)
 Next j
Next i
Range(Cells(1, 7), Cells(UBound(Array1, 1), 6 + UBound(AllArray, 2))) = AllArray

'ReDim Preserve AllArray(1 To UBound(AllArray, 1), 1 To (UBound(Array1, 2) + (UBound(Array2, 2))))

' AllArray = ?  This is first place I'm lost.

End Sub

 

[GeeWhiz7]

try this:

Option Explicit
Public AllArray() As Variant  'Would like this array to hold all arrays.

Sub Test()
Dim totcol, i, j
Dim ws As Worksheet
Dim Array1, Array2, Array3 As Variant

Set ws = Worksheets("Sheet1")

'####Technically I would have a loop here something like
'####For each ws in wsnames
'####Array = ws.Range("A1").CurrentRegion.Value
'####noting that row counts are always the same in each array, so only columns need to get added
'####starting location is also always the same (A1) on each sheet the loop accesses

Array1 = ws.Range("A1").CurrentRegion.Value
Array2 = ws.Range("A8").CurrentRegion.Value
Array3 = ws.Range("A15").CurrentRegion.Value

' Find total number of columns needed . Note it is better to define the array the correct size to start with since it is faster than using preserve
totcol = UBound(Array1, 2) + UBound(Array2, 2) + UBound(Array2, 2)

ReDim AllArray(1 To UBound(Array1, 1), 1 To totcol)
For i = 1 To UBound(Array1, 1)
 For j = 1 To UBound(Array1, 2)
  AllArray(i, j) = Array1(i, j)
 Next j
 ' note if all the arrays have the same number of columns then this could be simplifed
 For j = 1 To UBound(Array2, 2)
  AllArray(i, j + UBound(Array1, 2)) = Array2(i, j)
 Next j
 For j = 1 To UBound(Array3, 2)
  AllArray(i, j + UBound(Array1, 2) + UBound(Array2, 2)) = Array3(i, j)
 Next j
Next i
Range(Cells(1, 7), Cells(UBound(Array1, 1), 6 + UBound(AllArray, 2))) = AllArray

'ReDim Preserve AllArray(1 To UBound(AllArray, 1), 1 To (UBound(Array1, 2) + (UBound(Array2, 2))))

' AllArray = ?  This is first place I'm lost.

End Sub

Thank you once again Offthelip. This works to give me the right idea and thanks for note on redim preserve.

 

[Anthony47]

Working on the sample macro and sample data I went to this code:

Option Explicit
Public AllArray() As Variant  'Would like this array to hold all arrays.

Sub Test()
Dim ws As Worksheet
'Dim Array1, Array2, Array3 As Variant
Dim ArrArr(), Col0 As Long, MaxR As Long, MaxC As Long
Dim I As Long, J As Long, K As Long

Set ws = Worksheets("Sheet1")

ReDim ArrArr(1 To 3)        '1 to How many tables

ArrArr(1) = ws.Range("A1").CurrentRegion.Value
ArrArr(2) = ws.Range("A8").CurrentRegion.Value
ArrArr(3) = ws.Range("A15").CurrentRegion.Value

For I = 1 To UBound(ArrArr)
    If UBound(ArrArr(I)) > MaxR Then MaxR = UBound(ArrArr(I))
Next I
MaxC = UBound(ArrArr) * UBound(ArrArr(1), 2)
ReDim AllArray(1 To MaxR, 1 To MaxC)
'Copy each array in AllArray:
For I = 1 To UBound(ArrArr)                             'each array
    For J = 1 To UBound(ArrArr(I))                       'each row
        For K = 1 To UBound(ArrArr(I), 2)                 'each column
            AllArray(J, K + Col0) = ArrArr(I)(J, K)
        Next K
    Next J
    Col0 = Col0 + UBound(ArrArr(1), 2)
Next I
'Dump AllArray in Sheet1!G9
Range("G9").Resize(MaxR, MaxC).Value = AllArray
End Sub

This works with the three tables on Sheet1, create AllArray and copy AllArray to Sheet1-G9

The following code is the evolution of the above Sub Test; it expects a list of sheets to get the array from, then create as many arrays as the listed sheets, then create AllArray, that is eventually copied onto Sheet1-G9 for testing.
The code:

Sub Test_V2()
Dim wsNames
Dim ArrArr()                                            'used as an array of arrays
Dim Col0 As Long, MaxR As Long, MaxC As Long
Dim I As Long, J As Long, K As Long, WI As Long
'
wsNames = Array("Sheet1", "Sheet3", "Sheet7", "Sheet11", "Sheet12")           '<<< List of worksheets, TO BE COMPILED
'
ReDim ArrArr(1 To UBound(wsNames) + 1)                  '1 to How many Worksheets
'
'Get each of the arrays:
For WI = 0 To UBound(wsNames)
    ArrArr(WI + 1) = Sheets(wsNames(WI)).Range("A1").CurrentRegion.Value
Next WI
'Calculate max number of rows:
For I = 1 To UBound(ArrArr)
    If UBound(ArrArr(I)) > MaxR Then MaxR = UBound(ArrArr(I))
Next I
'Calculate tot number of columns:
MaxC = UBound(ArrArr) * UBound(ArrArr(1), 2)            'It assumes 3 col /array
'
'Resize (and clear) AllArray:
ReDim AllArray(1 To MaxR, 1 To MaxC)
'
'Move from Array to AllArray:
For I = 1 To UBound(ArrArr)                             'Each array
    For J = 1 To UBound(ArrArr(I))                       'each row
        For K = 1 To UBound(ArrArr(I), 2)                 'each column
            AllArray(J, K + Col0) = ArrArr(I)(J, K)     'Copy valur
        Next K
    Next J
    Col0 = Col0 + UBound(ArrArr(1), 2)                  'column offset
Next I
'
'for testing, dump AllArray to Sheet1!G9
Sheets("Sheet1").Range("G9").Resize(MaxR, MaxC).Value = AllArray
End Sub

Comments are more detailed than in the previous Sub Test, in case you need to tailor to your needs.
Note that I missed the info that each table has the same number of rows, so the macros examine each array to calculate AllArray rows; this remains a useless flexibility

Try...

 

[GeeWhiz7]

Working on the sample macro and sample data I went to this code:

Option Explicit
Public AllArray() As Variant  'Would like this array to hold all arrays.

Sub Test()
Dim ws As Worksheet
'Dim Array1, Array2, Array3 As Variant
Dim ArrArr(), Col0 As Long, MaxR As Long, MaxC As Long
Dim I As Long, J As Long, K As Long

Set ws = Worksheets("Sheet1")

ReDim ArrArr(1 To 3)        '1 to How many tables

ArrArr(1) = ws.Range("A1").CurrentRegion.Value
ArrArr(2) = ws.Range("A8").CurrentRegion.Value
ArrArr(3) = ws.Range("A15").CurrentRegion.Value

For I = 1 To UBound(ArrArr)
    If UBound(ArrArr(I)) > MaxR Then MaxR = UBound(ArrArr(I))
Next I
MaxC = UBound(ArrArr) * UBound(ArrArr(1), 2)
ReDim AllArray(1 To MaxR, 1 To MaxC)
'Copy each array in AllArray:
For I = 1 To UBound(ArrArr)                             'each array
    For J = 1 To UBound(ArrArr(I))                       'each row
        For K = 1 To UBound(ArrArr(I), 2)                 'each column
            AllArray(J, K + Col0) = ArrArr(I)(J, K)
        Next K
    Next J
    Col0 = Col0 + UBound(ArrArr(1), 2)
Next I
'Dump AllArray in Sheet1!G9
Range("G9").Resize(MaxR, MaxC).Value = AllArray
End Sub

This works with the three tables on Sheet1, create AllArray and copy AllArray to Sheet1-G9

The following code is the evolution of the above Sub Test; it expects a list of sheets to get the array from, then create as many arrays as the listed sheets, then create AllArray, that is eventually copied onto Sheet1-G9 for testing.
The code:

Sub Test_V2()
Dim wsNames
Dim ArrArr()                                            'used as an array of arrays
Dim Col0 As Long, MaxR As Long, MaxC As Long
Dim I As Long, J As Long, K As Long, WI As Long
'
wsNames = Array("Sheet1", "Sheet3", "Sheet7", "Sheet11", "Sheet12")           '<<< List of worksheets, TO BE COMPILED
'
ReDim ArrArr(1 To UBound(wsNames) + 1)                  '1 to How many Worksheets
'
'Get each of the arrays:
For WI = 0 To UBound(wsNames)
    ArrArr(WI + 1) = Sheets(wsNames(WI)).Range("A1").CurrentRegion.Value
Next WI
'Calculate max number of rows:
For I = 1 To UBound(ArrArr)
    If UBound(ArrArr(I)) > MaxR Then MaxR = UBound(ArrArr(I))
Next I
'Calculate tot number of columns:
MaxC = UBound(ArrArr) * UBound(ArrArr(1), 2)            'It assumes 3 col /array
'
'Resize (and clear) AllArray:
ReDim AllArray(1 To MaxR, 1 To MaxC)
'
'Move from Array to AllArray:
For I = 1 To UBound(ArrArr)                             'Each array
    For J = 1 To UBound(ArrArr(I))                       'each row
        For K = 1 To UBound(ArrArr(I), 2)                 'each column
            AllArray(J, K + Col0) = ArrArr(I)(J, K)     'Copy valur
        Next K
    Next J
    Col0 = Col0 + UBound(ArrArr(1), 2)                  'column offset
Next I
'
'for testing, dump AllArray to Sheet1!G9
Sheets("Sheet1").Range("G9").Resize(MaxR, MaxC).Value = AllArray
End Sub

Comments are more detailed than in the previous Sub Test, in case you need to tailor to your needs.
Note that I missed the info that each table has the same number of rows, so the macros examine each array to calculate AllArray rows; this remains a useless flexibility

Try...

Interesting. I’m still learning but thank you for this alternative. I think I will try both out.