Speed up of SumIf between two arrays (13k; 30) & (500, 30) based on double criteria - array loop

[d3rowy]

Dear MrExcel Lads,

I'm looking for a way to speed up my macro. Current timing varies between 30s if array2 has 500 rows and 2minutes if array2 contains 1500rows.

Case:
- two arrays: arrayInput & arrayAdjustments
- arrayAdjustment is created from a template in one of the sheets and then filled with data by week/keyfigure
- product & keyfigure combinatation is not unique in arrayinput
- product & keyfigure combination is unique in arrayAdjusments
- there are more types of keyfigures in arrayInput than in arrayAdjusments, im interested only in summing up what is in arrayAdjustment
- arrayAdjustments is basically a pivot with additional filtering of keyfigure, but it need it as raw table to process and change later

My current approach is to do it via array loops, is there a faster way? Or a way to optimize my code?
(I'm using a couple of public functions in the code below, but hope the their name will be self explanatory)

Sub adjSheetFill()


Dim timerAdj_fast As Single
timerAdj_fast = Timer()

Call sharedData.defineVariables

Dim numberColumnKeyFigure As Integer
Dim arrayInput As Variant, arrayKF As Variant, arrayAdjustment As Variant, result As Variant
Dim keyFigure As String, keyFigureInput As String, product As String
Dim rng As range, cell As range, sum As Double
Dim columnKeyFigureAdjustment As Integer, columnkeyFigureInput As Integer, phasing As Integer


arrayAdjustment = Worksheets(sheetAdjustments).range("A1").CurrentRegion.Value       'array with list of desired KF from workspace tab,

Dim r As Long, j As Long, i as Long

            arrayInput = createarrayInput
            arrayInput = addKeyColumnToArray(arrayInput)
            columnkeyFigureInput = findHeaderinArray(arrayInput, headerKeyFigures)
            columnKeyFigureAdjustment = findHeaderinArray(arrayAdjustment, headerKeyFigures)
            columnProductAdjustment = findHeaderinArray(arrayAdjustment, headerKey)
            phasing = columnkeyFigureInput - columnKeyFigureAdjustment

                      
    For r = LBound(arrayAdjustment, 1) + 1 To UBound(arrayAdjustment, 1)
            sum = 0

            keyFigure = arrayAdjustment(r, columnKeyFigureAdjustment)
            product = arrayAdjustment(r, columnProductAdjustment)

            For j = columnKeyFigureAdjustment + 1 To columnKeyFigureAdjustment + periodCountWeeks

            sum = 0

                For i = LBound(arrayInput, 1) + 1 To UBound(arrayInput, 1) - 1
                    If IsEmpty(arrayInput(i, columnkeyFigureInput)) Then
                    GoTo continue
                    End If

                sum = sum + arrayInput(i, j + phasing)
                arrayAdjustment(r, j) = sum

                Next i             

continue:

                sum = sum + arrayInput(i, j + phasing)
                arrayAdjustment(r, j) = sum

            Next j

    Next r


Worksheets(sheetAdjustment.range("A1:AD10000").ClearContents
Call pasteArray(arrayAdjustment, sheetAdjustment, "A1", 0)

Debug.Print "adjSheetFill_fast - end : " & Timer - timerAdj_fast

End Sub

Book1
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W
1	Product Desc	Key Figure	W02 2023	W03 2023	W04 2023	W05 2023	W06 2023	W07 2023	W08 2023	W09 2023	W10 2023	W11 2023	W12 2023	W13 2023	W14 2023	W15 2023	W16 2023	W17 2023	W18 2023	W19 2023	W20 2023	W21 2023	W22 2023
2	Apple	Factor 1	30	26.25	26.25	22.5	22.5	26.25	22.5	22.5	22.5	22.5	22.5	22.5	22.5	22.5	22.5	22.5	22.5	22.5	22.5	22.5	22.5
3	Apple	Factor 2	30	26.25	26.25	22.5	22.5	26.25	22.5	22.5	22.5	22.5	22.5	22.5	22.5	22.5	22.5	22.5	22.5	22.5	22.5	22.5	22.5
4	Apple	Stat Factor	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0
5	Apple	Adjusted Stat Factor	25.591396	25.591396	25.591396	27.549923	28.333335	28.333335	28.333335	28.186762	31.141869	31.141869	31.141869	31.141869	31.141869	31.141869	31.141869	31.141869	31.141869	31.141869	31.141869	31.141869	31.141869
6	Apple	Baseline	25.591396	25.591396	25.591396	27.549923	28.333335	28.333335	28.333335	28.186762	31.141869	31.141869	31.141869	31.141869	31.141869	31.141869	31.141869	31.141869	31.141869	31.141869	31.141869	31.141869	31.141869
7	Apple	Promotion
8	Apple	Sales
9	Apple	Sales Plan	25.591396	25.591396	25.591396	27.549923	28.333335	28.333335	28.333335	28.186762	31.141869	31.141869	31.141869	31.141869	31.141869	31.141869	31.141869	31.141869	31.141869	31.141869	31.141869	31.141869	31.141869
10	Apple	Sales Adjustments
11	Apple	Demand	-12.172228	-12.172228	-12.172228	-8.264976	-8.5	-8.5
12	Apple	Consensus Demand	13.419168	13.419168	13.419168	19.284947	19.833335	19.833335	28.333335	28.186762	31.141869	31.141869	31.141869	31.141869	31.141869	31.141869	31.141869	31.141869	31.141869	31.141869	31.141869	31.141869	31.141869
13	Apple	Customer Demand
14	Apple	Total Demand				45	45		45		45		31.141869	31.141869	31.141869	31.141869	31.141869	31.141869	31.141869	31.141869	31.141869	31.141869	31.141869
15	Apple	Actuals				45	45		45		45
16	Apple	Stock
17	Banana	Factor 1	45	41.25	37.5	33.75	33.75	37.5	30	26.25	45	45	45	45	45	45	45	45	45	45	45	45	45
18	Banana	Factor 2	45	41.25	37.5	33.75	33.75	37.5	30	26.25	45	45	45	45	45	45	45	45	45	45	45	45	45
19	Banana	Stat Factor	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0
20	Banana	Adjusted Stat Factor	42.41795	42.41795	44.383563	44.383563	44.383563	44.383563	44.383563	35.5362	38.297873	39.010418	39.010418	39.010417	39.010418	39.010418	39.010418	39.010418	39.010418	39.010418	39.010418	39.010418	39.010417
21	Banana	Baseline	42.41795	42.41795	44.383563	44.383563	44.383563	44.383563	44.383563	35.5362	38.297873	39.010418	39.010418	39.010417	39.010418	39.010418	39.010418	39.010418	39.010418	39.010418	39.010418	39.010418	39.010417
22	Banana	Promotion
23	Banana	Sales
24	Banana	Sales Plan	42.41795	42.41795	44.383563	44.383563	44.383563	44.383563	44.383563	35.5362	38.297873	39.010418	39.010418	39.010417	39.010418	39.010418	39.010418	39.010418	39.010418	39.010418	39.010418	39.010418	39.010417
25	Banana	Sales Adjustments
26	Banana	Demand	0	0	0	0
27	Banana	Consensus Demand	42.41795	42.41795	44.383563	44.383563	44.383563	44.383563	44.383563	35.5362	38.297873	39.010418	39.010418	39.010417	39.010418	39.010418	39.010418	39.010418	39.010418	39.010418	39.010418	39.010418	39.010417
28	Banana	Customer Demand
29	Banana	Total Demand				45	45		90	225			39.010418	39.010417	39.010418	39.010418	39.010418	39.010418	39.010418	39.010418	39.010418	39.010418	39.010417
30	Banana	Actuals				45	45		90	225
31	Banana	Stock
32	Apple	Factor 1	180	165	165	172.5	168.75	90	108.75	127.5	131.25	135	135	135	135	135	135	135	135	135	135	135	135
33	Apple	Factor 2	180	165	165	172.5	168.75	90	108.75	127.5	131.25	135	135	135	135	135	135	135	135	135	135	135	135
34	Apple	Stat Factor	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0
35	Apple	Adjusted Stat Factor	155.806438	155.806437	179.572448	179.572448	179.572448	179.572448	179.572448	150.562641	188.558469	188.558469	188.558469	188.558468	188.558469	188.558469	188.558469	188.558469	188.558469	188.558469	188.558469	188.558469	188.558469
36	Apple	Baseline	155.806438	155.806437	179.572448	179.572448	179.572448	179.572448	179.572448	150.562641	188.558469	188.558469	188.558469	188.558468	188.558469	188.558469	188.558469	188.558469	188.558469	188.558469	188.558469	188.558469	188.558469
37	Apple	Promotion
38	Apple	Sales
39	Apple	Sales Plan	155.806438	155.806437	179.572448	179.572448	179.572448	179.572448	179.572448	150.562641	188.558469	188.558469	188.558469	188.558468	188.558469	188.558469	188.558469	188.558469	188.558469	188.558469	188.558469	188.558469	188.558469
40	Apple	Sales Adjustments
41	Apple	Demand	0	0	-53.871734	-53.871734	-53.871734	-53.871734
42	Apple	Consensus Demand	155.806438	155.806437	125.700714	125.700714	125.700714	125.700714	179.572448	150.562641	188.558469	188.558469	188.558469	188.558468	188.558469	188.558469	188.558469	188.558469	188.558469	188.558469	188.558469	188.558469	188.558469
43	Apple	Customer Demand	0	0	0	0
44	Apple	Total Demand	42.41795	42.41795	44.383563	44.383563	44.383563	44.383563	44.383563	35.5362	38.297873	39.010418	39.010418	39.010417	39.010418	39.010418	39.010418	39.010418	39.010418	39.010418	39.010418	39.010418	39.010417
45	Apple	Actuals
46	Apple	Stock				45	45		90	225			39.010418	39.010417	39.010418	39.010418	39.010418	39.010418	39.010418	39.010418	39.010418	39.010418	39.010417
arrayInput

Book1
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W
16	Product Desc	Key Figure	Sum of W02 2023	Sum of W03 2023	Sum of W04 2023	Sum of W05 2023	Sum of W06 2023	Sum of W07 2023	Sum of W08 2023	Sum of W09 2023	Sum of W10 2023	Sum of W11 2023	Sum of W12 2023	Sum of W13 2023	Sum of W14 2023	Sum of W15 2023	Sum of W16 2023	Sum of W17 2023	Sum of W18 2023	Sum of W19 2023	Sum of W20 2023	Sum of W21 2023	Sum of W22 2023
17	Apple	Actuals
18	Apple	Demand
19	Apple	Promotion
20	Apple	Sales
21	Banana	Actuals
22	Banana	Demand
23	Banana	Promotion
24	Banana	Sales
arrayAdjustmentsEmpty

Book1
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W
16	Product Desc	Key Figure	Sum of W02 2023	Sum of W03 2023	Sum of W04 2023	Sum of W05 2023	Sum of W06 2023	Sum of W07 2023	Sum of W08 2023	Sum of W09 2023	Sum of W10 2023	Sum of W11 2023	Sum of W12 2023	Sum of W13 2023	Sum of W14 2023	Sum of W15 2023	Sum of W16 2023	Sum of W17 2023	Sum of W18 2023	Sum of W19 2023	Sum of W20 2023	Sum of W21 2023	Sum of W22 2023
17	Apple	Actuals				45	45		45		45
18	Apple	Demand	-12.172228	-12.172228	-66.043962	-62.13671	-62.371734	-62.371734
19	Apple	Promotion
20	Apple	Sales
21	Banana	Actuals				45	45		90	225
22	Banana	Demand	0	0	0	0
23	Banana	Promotion
24	Banana	Sales
arrayAdjustmentsFilled

 

[kevin9999]

This may take a few goes to get right, but here's a start. Try the following code on a copy of your file.

Option Explicit
Sub Multi_Keys_Multi_Items()
    Dim t As Double: t = Timer
    Dim rng As Range, R As Range, txt As String
    Dim i As Long, j As Long, n As Long, ar
    
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("arrayInput")      '<~~~ Check names of source & destination sheets carefully
    Set ws2 = Worksheets("arrayAdjustments")
    
    Set rng = ws1.Range("A1:A" & ws1.Cells(Rows.Count, "A").End(xlUp).Row)
    ar = ws1.Range("A1").CurrentRegion
    
    With CreateObject("scripting.dictionary")
        For Each R In rng
            txt = R.Value2 & "|" & R.Offset(0, 1).Value
            If Not .exists(txt) Then
                n = n + 1
                .Add txt, n
                For j = 1 To UBound(ar, 2)
                    ar(n, j) = R.Offset(, j - 1)
                Next j
            Else
                For i = 3 To UBound(ar, 2)
                    ar(.Item(txt), i) = ar(.Item(txt), i) + R.Offset(, i - 1)
                Next i
            End If
        Next R
    End With
    ws2.Range("A1").CurrentRegion.Offset(1).ClearContents
    ws2.Range("A1").Resize(n, UBound(ar, 2)) = ar
    MsgBox "adjSheetFill_fast - end : " & Timer - t & " seconds."
End Sub

 

[kevin9999]

Did you try the code in post #2?

 

[d3rowy]

Hi Kevin, thank you for posting your code. I will try it today

 

[kevin9999]

Thanks you for that Looking back at my post, I think I should have explained a bit better how the code actually works. As you probably gathered, it uses a Dictionary approach rather than arrays (dictionaries are brilliant for ultra fast sumifs etc.). As a test, put all your data in your arrayInput sheet on one sheet, and have a second sheet in the same workbook (completely blank) called arrayAdjustments. I tested it on 3K rows and it completed in under 0.5 seconds. I have made a couple of improvements to the code I posted earlier, if you'd like to try this instead?

Option Explicit
Sub Multi_Keys_Multi_Items_V2()
    Dim t As Double: t = Timer
    Dim rng As Range, R As Range, txt As String
    Dim i As Long, j As Long, n As Long, ar
    
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("arrayInput")      '<~~~ Check names of source & destination sheets carefully
    Set ws2 = Worksheets("arrayAdjustments")
    
    Set rng = ws1.Range("A1:A" & ws1.Cells(Rows.Count, "A").End(xlUp).Row)
    ar = ws1.Range("A1").CurrentRegion
    
    With CreateObject("scripting.dictionary")
        For Each R In rng
            txt = R.Value2 & "|" & R.Offset(0, 1).Value
            If Not .exists(txt) Then
                n = n + 1
                .Add txt, n
                For j = 1 To UBound(ar, 2)
                    ar(n, j) = R.Offset(, j - 1)
                Next j
            Else
                For i = 3 To UBound(ar, 2)
                    ar(.Item(txt), i) = ar(.Item(txt), i) + R.Offset(, i - 1)
                Next i
            End If
        Next R
    End With
    ws2.Range("A1").CurrentRegion.Offset(1).ClearContents
    ws2.Range("A1").Resize(n, UBound(ar, 2)) = ar
    
    With ws2.Range(ws2.Cells(2, 3), ws2.Cells(Cells.Find("*", , xlFormulas, , 1, 2).Row, ws2.Cells(1, Columns.Count).End(xlToLeft).Column))
        .Replace 0, "", 1
    End With
    
    For i = 3 To ws2.Cells(1, Columns.Count).End(xlToLeft).Column
        ws2.Cells(1, i) = "Sum of " & ws2.Cells(1, i)
    Next i
    ws2.UsedRange.EntireColumn.AutoFit
    MsgBox "adjSheetFill_fast - end : " & Timer - t & " seconds."
End Sub

 

[d3rowy]

I managed to get it partially going and it looks very promising <2s for 13k rows! Thank you . What I'm maybe missing or do not understand is the content or "ar" tail rows.
"ar" is initially declared as whole content of "arrayInut" ~13k rows, then code is looping through looking for unique key, if its there then it effectively overwriting given row of "ar" with what it found. If its not unique it will sumup all the data and put it in again in given row of "ar", this is clear. But if we will find only 500 unique keys (txt), wont it overwrite only first 500 rows and we are still left with 12.5k tail rows in the same array?

 

[kevin9999]

I'm not following you 100%. The array 'ar' is put into the second sheet ("arrayAdjustments" or "ws2" in my code) after that second sheet is cleared of all its data first. The data in the first sheet ("arrayInput" or "ws1" in my code) shouldn't be affected at all. Is this not quite what you were after?

 

[d3rowy]

This is exactly what we are after, yes.

By using this piece, we are putting whole arrayInput sheet, in my case all 13k rows into array "ar".

    Set ws1 = Worksheets("arrayInput")      '<~~~ Check names of source & destination sheets carefully
    Set rng = ws1.Range("A1:A" & ws1.Cells(Rows.Count, "A").End(xlUp).Row)
    ar = ws1.Range("A1").CurrentRegion

Then we proceed to overwrite some of ar values, based on dictionary entries:

 If Not .exists(txt) Then
                n = n + 1
                .Add txt, n
                For j = 1 To UBound(ar, 2)
                    ar(n, j) = R.Offset(, j - 1)
                Next j
            Else
                For i = 3 To UBound(ar, 2)
                    ar(.Item(txt), i) = ar(.Item(txt), i) + R.Offset(, i - 1)
                Next i
            End If

But n will never reach 13k, as there is a lot of duplicated entries. Product & key figure combination in arrayInput is not unique. We overwrite only n amount of rows in "ar" and are left with 13k - n that originally came from the 1st code snippet. I'm trying to understand if this is the case, or im missing smth in process.
If this is truly the case then solution is quite easy - cutting rows from ar / putting data in other array

 

[kevin9999]

Then we proceed to overwrite some of ar values, based on dictionary entries:

Not quite, you don't actually "overwrite" any values - you use the array "ar" to build the Dictionary based on unique entries only.

We overwrite only n amount of rows in "ar" and are left with 13k - n that originally came from the 1st code snippet. I'm trying to understand if this is the case, or im missing smth in process.

Again, you don't actually "overwrite" anything. If the product+key combination have already been added to the dictionary, then the values are added to what already exists against that product-key combination - effectively doing a Sumifs(). You're not actually left with "13k - n" as you put it, you're left with n.

If this is truly the case then solution is quite easy - cutting rows from ar / putting data in other array

Don't follow this bit. Is this a question, or a proposed "solution" to a problem? If so, what is the problem? Or am I just getting tired (been a long day )

 

[d3rowy]

Thank you for all the help, please get some rest As I though, I'm misunderstanding what the code is doing, but I will get there.
You help me tremendously, once again - thank you!