Looping and Combining two arrays

Guinaba

Board Regular
Joined
Sep 19, 2018
Messages
215
Office Version
  1. 2016
Platform
  1. Windows
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 Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).
How have you populated UniqArr?
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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?
 
Upvote 0
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.
 
Upvote 0
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?
 
Upvote 0
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?
 
Upvote 0
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
 
Upvote 0

Forum statistics

Threads
1,213,562
Messages
6,114,322
Members
448,564
Latest member
ED38

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
Back
Top