Looping and Combining two arrays

Guinaba

Board Regular
Joined
Sep 19, 2018
Messages
101
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:

WkArrUniqArr
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 DateBrandSKUIDColorShape
2/01/2021Tonto
45678​
GreenSquare
9/01/2021Tonto
45678​
GreenSquare
16/01/2021Tonto
45678​
GreenSquare
23/01/2021Tonto
45678​
GreenSquare
30/01/2021Tonto
45678​
GreenSquare
2/01/2021Benq
45698​
BlueOval
9/01/2021Benq
45698​
BlueOval
16/01/2021Benq
45698​
BlueOval
23/01/2021Benq
45698​
BlueOval
30/01/2021Benq
45698​
BlueOval

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
Joined
Apr 28, 2004
Messages
76,298
Office Version
  1. 365
Platform
  1. Windows
How have you populated UniqArr?
 

Norie

Well-known Member
Joined
Apr 28, 2004
Messages
76,298
Office Version
  1. 365
Platform
  1. Windows
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
Joined
Sep 19, 2018
Messages
101
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
Joined
Sep 19, 2018
Messages
101

ADVERTISEMENT

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
        Dic.Add buf, buf
    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





BrandMFA RefWOW RefDescriptionCalendar Week2/01/20199/01/201916/01/201923/01/201930/01/20196/02/201913/02/201920/02/201927/02/20196/03/201913/03/201920/03/201927/03/20193/04/201910/04/201917/04/201924/04/20191/05/20198/05/201915/05/201922/05/201929/05/20195/06/201912/06/201919/06/201926/06/20193/07/201910/07/201917/07/201924/07/201931/07/20197/08/201914/08/201921/08/201928/08/20194/09/201911/09/201918/09/201925/09/20192/10/20199/10/201916/10/201923/10/201930/10/20196/11/201913/11/201920/11/201927/11/20194/12/201911/12/201918/12/201925/12/20191/01/20208/01/202015/01/202022/01/202029/01/20205/02/202012/02/202019/02/202026/02/20204/03/202011/03/202018/03/202025/03/20201/04/20208/04/202015/04/202022/04/202029/04/20206/05/202013/05/202020/05/202027/05/20203/06/202010/06/202017/06/202024/06/20201/07/20208/07/202015/07/202022/07/202029/07/20205/08/202012/08/202019/08/202026/08/20202/09/20209/09/202016/09/202023/09/202030/09/20207/10/202014/10/202021/10/202028/10/20204/11/202011/11/202018/11/202025/11/20202/12/20209/12/202016/12/202023/12/202030/12/20206/01/202113/01/202120/01/202127/01/20213/02/202110/02/202117/02/202124/02/20213/03/202110/03/202117/03/202124/03/202131/03/20217/04/202114/04/202121/04/202128/04/20215/05/202112/05/202119/05/202126/05/20212/06/20219/06/202116/06/202123/06/202130/06/20217/07/202114/07/202121/07/202128/07/20214/08/202111/08/202118/08/202125/08/20211/09/20218/09/202115/09/202122/09/202129/09/20216/10/202113/10/202120/10/202127/10/20213/11/202110/11/202117/11/202124/11/20211/12/20218/12/202115/12/202122/12/202129/12/20215/01/202212/01/202219/01/202226/01/20222/02/20229/02/202216/02/2022
Babybel101329370480Babybel Cheese Portions 200g
Babybel101329370480Babybel Cheese Portions 200g
Babybel101329370480Babybel Cheese Portions 200g
Babybel101329370480Babybel Cheese Portions 200g
Babybel101329370480Babybel Cheese Portions 200g
Babybel101329370480Babybel Cheese Portions 200g
Babybel101329370480Babybel Cheese Portions 200g
Babybel101329370480Babybel Cheese Portions 200g
Babybel101329370480Babybel Cheese Portions 200g
Babybel101329370480Babybel Cheese Portions 200g
Babybel101329370480Babybel Cheese Portions 200g
Babybel101329370480Babybel Cheese Portions 200g
Babybel101329370480Babybel Cheese Portions 200g
Babybel101329370480Babybel Cheese Portions 200g
Babybel101329370480Babybel Cheese Portions 200g
Babybel101329370480Babybel Cheese Portions 200g
Babybel101329370480Babybel Cheese Portions 200g
Babybel101329370480Babybel Cheese Portions 200g
Babybel101329370480Babybel Cheese Portions 200g
 

Norie

Well-known Member
Joined
Apr 28, 2004
Messages
76,298
Office Version
  1. 365
Platform
  1. Windows
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
Joined
Sep 19, 2018
Messages
101

ADVERTISEMENT

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
        Dic.Add buf, buf
    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
Joined
Apr 28, 2004
Messages
76,298
Office Version
  1. 365
Platform
  1. Windows
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
Joined
Sep 19, 2018
Messages
101
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
Joined
Sep 19, 2018
Messages
101
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.

1611107789993.png
 

Watch MrExcel Video

Forum statistics

Threads
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.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

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

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

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
Top