# Looping and Combining two arrays

#### Guinaba

##### Board Regular
Hi guys,

Wondering if someone could help me out, I have two arrays (below) and I'd like to combine both in a third one using the following logic:

 WkArr UniqArr WkArr(1,1) = "Week Commencing Date" WkArr(1,2) = #2/01/2021# WkArr(1,3) = #9/01/2021# WkArr(1,4) = #16/01/2021# WkArr(1,5) = #23/01/2021# WkArr(1,6) = #30/01/2021# UniqArr(0)(0) = "Brand" UniqArr(0)(1) = "SKUID" UniqArr(0)(2) = "Color" UniqArr(0)(3) = "Shape" UniqArr(1) UniqArr(1)(0) = "Tonto" UniqArr(1)(1) = "45678" UniqArr(1)(2) = "Green" UniqArr(1)(3) = "Square" UniqArr(2) UniqArr(2)(0) = "Benq" UniqArr(2)(1) = "45698" UniqArr(2)(2) = "Blue" UniqArr(2)(3) = "Oval"

Final Result:
 Week Commencing Date Brand SKUID Color Shape 2/01/2021 Tonto 45678​ Green Square 9/01/2021 Tonto 45678​ Green Square 16/01/2021 Tonto 45678​ Green Square 23/01/2021 Tonto 45678​ Green Square 30/01/2021 Tonto 45678​ Green Square 2/01/2021 Benq 45698​ Blue Oval 9/01/2021 Benq 45698​ Blue Oval 16/01/2021 Benq 45698​ Blue Oval 23/01/2021 Benq 45698​ Blue Oval 30/01/2021 Benq 45698​ Blue Oval

VBA Code:
``````'Variant to hold the array element
Dim Wk_Start As Variant

'Array to keep combination between weeks and master data arrays
Dim ComboArr() As Variant
Dim r As Integer, c As Integer

'Loop through the entire array
For Each Wk_Start In WkArr
For r = 2 To UBound(UniqArr)
For c = 2 To UBound(UniqArr)
ComboArr(r, c) = UniqArr(r, c)
Next c
Next r
Next Wk_Start``````

### Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type

#### Norie

##### Well-known Member
How have you populated UniqArr?

#### Norie

##### Well-known Member
I've hard-coded the arrays in the code below.
VBA Code:
``````Public Sub CombineArrays()
Dim WkArr(1 To 1, 1 To 6)
Dim UniqArr(2)
Dim CombinArr()
Dim I As Long
Dim J As Long
Dim K As Long
Dim cnt As Long

WkArr(1, 1) = "Week Commencing Date"
WkArr(1, 2) = #2/1/2021#
WkArr(1, 3) = #9/1/2021#
WkArr(1, 4) = #1/16/2021#
WkArr(1, 5) = #1/23/2021#
WkArr(1, 6) = #1/30/2021#

UniqArr(0) = Array("Brand", "SKUID", "Color", "Shape")
UniqArr(1) = Array("Tonto", "45678", "Green", "Square")
UniqArr(2) = Array("Benq", "45698", "Blue", "Oval")

ReDim CombinArr(1 To 11, 1 To 5)

CombinArr(1, 1) = WkArr(1, 1)

For I = 0 To UBound(UniqArr(0))
CombinArr(1, I + 2) = UniqArr(0)(I)
Next I

cnt = 2

For I = 1 To UBound(UniqArr)
For J = 2 To UBound(WkArr, 2)

CombinArr(cnt, 1) = WkArr(1, J)
For K = 0 To UBound(UniqArr(I))
CombinArr(cnt, K + 2) = UniqArr(I)(K)
Next K
cnt = cnt + 1
Next J
Next I

End Sub``````

#### Guinaba

##### Board Regular
I've hard-coded the arrays in the code below.
VBA Code:
``````Public Sub CombineArrays()
Dim WkArr(1 To 1, 1 To 6)
Dim UniqArr(2)
Dim CombinArr()
Dim I As Long
Dim J As Long
Dim K As Long
Dim cnt As Long

WkArr(1, 1) = "Week Commencing Date"
WkArr(1, 2) = #2/1/2021#
WkArr(1, 3) = #9/1/2021#
WkArr(1, 4) = #1/16/2021#
WkArr(1, 5) = #1/23/2021#
WkArr(1, 6) = #1/30/2021#

UniqArr(0) = Array("Brand", "SKUID", "Color", "Shape")
UniqArr(1) = Array("Tonto", "45678", "Green", "Square")
UniqArr(2) = Array("Benq", "45698", "Blue", "Oval")

ReDim CombinArr(1 To 11, 1 To 5)

CombinArr(1, 1) = WkArr(1, 1)

For I = 0 To UBound(UniqArr(0))
CombinArr(1, I + 2) = UniqArr(0)(I)
Next I

cnt = 2

For I = 1 To UBound(UniqArr)
For J = 2 To UBound(WkArr, 2)

CombinArr(cnt, 1) = WkArr(1, J)
For K = 0 To UBound(UniqArr(I))
CombinArr(cnt, K + 2) = UniqArr(I)(K)
Next K
cnt = cnt + 1
Next J
Next I

End Sub``````

#### Guinaba

##### Board Regular

Thanks a lot @Norie for your help! Much appreciate it! However, I should have added the file format to make easier to write the logic. Not sure why but your code is not going to the end of the date period, it stops after the 20th loop, most likely becasue the last row is 20 (see file below). I have replaced in your code I for R and added LastRow into ReDim CombinArr(1 To LastRow, 1 To 5).

I have added the entire code to show you how I am populating the UniqArr() and Wk_Start. For UniqArr() am I using data dict. to remove the duplicate entries.

Could you please have a look into your code again and see whether we could adjusted to consider all the period weeks?

VBA Code:
``````Sub Combo_WK_Master_Data()

Dim WS1 As Worksheet
Set WS1 = ThisWorkbook.Worksheets("PromoGrid")
Dim LastRow, lastCol As Long
LastRow = WS1.Cells(WS1.Rows.Count, "A").End(xlUp).Row
lastCol = WS1.Cells(1, WS1.Columns.Count).End(xlToLeft).Column

'********Master Data Range*********

Dim Dic, buf As String, Keys
Dim I As Long
Dim UniqArr()

Set Dic = CreateObject("Scripting.Dictionary") 'Creating Data Dic to store unique entries from the range

With WS1 'Looping through the dic
On Error Resume Next
LastRow = .Cells(Rows.Count, 1).End(xlUp).Row
For I = 3 To LastRow
buf = .Cells(I, 2).Value & "," & .Cells(I, 3).Value & "," & .Cells(I, 4).Value & "," & .Cells(I, 5).Value
Next
On Error GoTo 0

Keys = Dic.Keys
For I = 0 To Dic.Count - 1 'Saving unique entries into UniqArr
ReDim Preserve UniqArr(I)
UniqArr(I) = Split(Keys(I), ",")
Next

End With
Set Dic = Nothing 'Relasing dic from memory

'********Week Period Range*********

Dim WkArr() As Variant
Dim WKRange As Range 'Period Week Range
Set WKRange = WS1.Range(Cells(1, 5), Cells(1, lastCol))
WkArr = WKRange 'Assigning Range to Array

'Declare a variant to hold the array element
Dim Wk_Start As Variant

'Array to combine weeks and master data
Dim CombinArr() As Variant
Dim R As Long
Dim J As Long
Dim K As Long
Dim cnt As Long

ReDim CombinArr(1 To LastRow, 1 To 5)

CombinArr(1, 1) = WkArr(1, 1)

For R = 0 To UBound(UniqArr(0))
CombinArr(1, R + 2) = UniqArr(0)(R)
Next R

cnt = 2

For R = 1 To UBound(UniqArr)
For J = 2 To UBound(WkArr, 2)
CombinArr(cnt, 1) = WkArr(1, J)
For K = 0 To UBound(UniqArr(R))
CombinArr(cnt, K + 2) = UniqArr(R)(K)
Next K
cnt = cnt + 1
Next J
Next R

End Sub``````

 Brand MFA Ref WOW Ref Description Calendar Week 2/01/2019 9/01/2019 16/01/2019 23/01/2019 30/01/2019 6/02/2019 13/02/2019 20/02/2019 27/02/2019 6/03/2019 13/03/2019 20/03/2019 27/03/2019 3/04/2019 10/04/2019 17/04/2019 24/04/2019 1/05/2019 8/05/2019 15/05/2019 22/05/2019 29/05/2019 5/06/2019 12/06/2019 19/06/2019 26/06/2019 3/07/2019 10/07/2019 17/07/2019 24/07/2019 31/07/2019 7/08/2019 14/08/2019 21/08/2019 28/08/2019 4/09/2019 11/09/2019 18/09/2019 25/09/2019 2/10/2019 9/10/2019 16/10/2019 23/10/2019 30/10/2019 6/11/2019 13/11/2019 20/11/2019 27/11/2019 4/12/2019 11/12/2019 18/12/2019 25/12/2019 1/01/2020 8/01/2020 15/01/2020 22/01/2020 29/01/2020 5/02/2020 12/02/2020 19/02/2020 26/02/2020 4/03/2020 11/03/2020 18/03/2020 25/03/2020 1/04/2020 8/04/2020 15/04/2020 22/04/2020 29/04/2020 6/05/2020 13/05/2020 20/05/2020 27/05/2020 3/06/2020 10/06/2020 17/06/2020 24/06/2020 1/07/2020 8/07/2020 15/07/2020 22/07/2020 29/07/2020 5/08/2020 12/08/2020 19/08/2020 26/08/2020 2/09/2020 9/09/2020 16/09/2020 23/09/2020 30/09/2020 7/10/2020 14/10/2020 21/10/2020 28/10/2020 4/11/2020 11/11/2020 18/11/2020 25/11/2020 2/12/2020 9/12/2020 16/12/2020 23/12/2020 30/12/2020 6/01/2021 13/01/2021 20/01/2021 27/01/2021 3/02/2021 10/02/2021 17/02/2021 24/02/2021 3/03/2021 10/03/2021 17/03/2021 24/03/2021 31/03/2021 7/04/2021 14/04/2021 21/04/2021 28/04/2021 5/05/2021 12/05/2021 19/05/2021 26/05/2021 2/06/2021 9/06/2021 16/06/2021 23/06/2021 30/06/2021 7/07/2021 14/07/2021 21/07/2021 28/07/2021 4/08/2021 11/08/2021 18/08/2021 25/08/2021 1/09/2021 8/09/2021 15/09/2021 22/09/2021 29/09/2021 6/10/2021 13/10/2021 20/10/2021 27/10/2021 3/11/2021 10/11/2021 17/11/2021 24/11/2021 1/12/2021 8/12/2021 15/12/2021 22/12/2021 29/12/2021 5/01/2022 12/01/2022 19/01/2022 26/01/2022 2/02/2022 9/02/2022 16/02/2022 Babybel 101329 370480 Babybel Cheese Portions 200g Babybel 101329 370480 Babybel Cheese Portions 200g Babybel 101329 370480 Babybel Cheese Portions 200g Babybel 101329 370480 Babybel Cheese Portions 200g Babybel 101329 370480 Babybel Cheese Portions 200g Babybel 101329 370480 Babybel Cheese Portions 200g Babybel 101329 370480 Babybel Cheese Portions 200g Babybel 101329 370480 Babybel Cheese Portions 200g Babybel 101329 370480 Babybel Cheese Portions 200g Babybel 101329 370480 Babybel Cheese Portions 200g Babybel 101329 370480 Babybel Cheese Portions 200g Babybel 101329 370480 Babybel Cheese Portions 200g Babybel 101329 370480 Babybel Cheese Portions 200g Babybel 101329 370480 Babybel Cheese Portions 200g Babybel 101329 370480 Babybel Cheese Portions 200g Babybel 101329 370480 Babybel Cheese Portions 200g Babybel 101329 370480 Babybel Cheese Portions 200g Babybel 101329 370480 Babybel Cheese Portions 200g Babybel 101329 370480 Babybel Cheese Portions 200g

#### Norie

##### Well-known Member
To get the no of rows in the combined array you need to multiply the no of dates by the no of products and add 1 for the header

In the original example there were 5 dates and 2 products, hence 11 rows in the combined array- 2 x 5 + 1.

As for how you are populating the arrays is the posted data what you are starting with?

#### Guinaba

##### Board Regular

To get the no of rows in the combined array you need to multiply the no of dates by the no of products and add 1 for the header

In the original example there were 5 dates and 2 products, hence 11 rows in the combined array- 2 x 5 + 1.

As for how you are populating the arrays is the posted data what you are starting with?
Hi @Norie,

The number of dates and the no of products are dynamically populated, the increase every week. Answering your question how I am populating the arrays:

The array WkArr (having the dates) I populated it dynamcally
VBA Code:
``````  Dim WS1 As Worksheet
Set WS1 = ThisWorkbook.Worksheets("PromoGrid")
Dim LastRow, lastCol As Long
LastRow = WS1.Cells(WS1.Rows.Count, "A").End(xlUp).Row
lastCol = WS1.Cells(1, WS1.Columns.Count).End(xlToLeft).Column

'********Week Period Range*********

Dim WkArr() As Variant
Dim WKRange As Range 'Period Week Range
Set WKRange = WS1.Range(Cells(1, 5), Cells(1, lastCol))
WkArr = WKRange 'Assigning Range to Array``````

The array UniqArr (having the data) I populated dynamcally removing duplicate rows, using data dictionary.
VBA Code:
``````'********Master Data Range*********

Dim Dic, buf As String, Keys
Dim I As Long
Dim UniqArr()

Set Dic = CreateObject("Scripting.Dictionary") 'Creating Data Dic to store unique entries from the range

With WS1 'Looping through the dic
On Error Resume Next
For I = 3 To LastRow
buf = .Cells(I, 2).Value & "," & .Cells(I, 3).Value & "," & .Cells(I, 4).Value & "," & .Cells(I, 5).Value
Next
On Error GoTo 0

Keys = Dic.Keys
For I = 0 To Dic.Count - 1 'Saving unique entries into UniqArr
ReDim Preserve UniqArr(I)
UniqArr(I) = Split(Keys(I), ",")
Next

End With
Set Dic = Nothing 'Relasing dic from memory``````

You mentioned that the number of rows in the original example were 5 dates and 2 products, hence 11 rows in the combined array- 2 x 5 + 1. How could we make it dynamic? I have tried
ReDim CombinArr(1 To UBound(UniqArr), 1 To 5) but I keep getting out of range error.

#### Norie

##### Well-known Member
The no of products is the upper bound of UniqArr, the no of dates is the upper bound of WkArr minus 1.

So try something like this.
VBA Code:
``ReDim CombinArr(1 To (UBound(UniqArr) * (UBound(WkArr)-1)) +1, 1 to 5)``

I'm still not quite following what you are doing to populate UniqArr.

The reason I'm interested in that part is because it's probably better to have a single array rather than an array of arrays.

Could you post some further sample data, the previous data only appeared to have one product?

#### Guinaba

##### Board Regular
The no of products is the upper bound of UniqArr, the no of dates is the upper bound of WkArr minus 1.

So try something like this.
VBA Code:
``ReDim CombinArr(1 To (UBound(UniqArr) * (UBound(WkArr)-1)) +1, 1 to 5)``

I'm still not quite following what you are doing to populate UniqArr.

The reason I'm interested in that part is because it's probably better to have a single array rather than an array of arrays.

Could you post some further sample data, the previous data only appeared to have one product?
Hi @Nori is there any way I can send you the entire sheet?

#### Guinaba

##### Board Regular
Hi @Norie,

I did added your suggestion: ReDim CombinArr(1 To (UBound(UniqArr) * (UBound(WkArr)-1)) +1, 1 to 5) but I'm getting Run-time error "9" - Subscript out of Range, in the line highlihted below, doing more investigation.

Replies
0
Views
35
Replies
9
Views
114
Replies
13
Views
125
Replies
1
Views
133
Replies
19
Views
486

1,133,270
Messages
5,657,753
Members
418,411
Latest member
Excellency

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back