VBA code for SUMIFS function

[Akira181]

I'm very new to VBA and I'm currently struggling with how to do a SUMIFS code with a table of data. I can follow along some tutorials and examples to get it to work for a single cell, but struggling when it comes to a full table of data.

I'm trying to find the total cost for each unique reference in Sheet 2 and paste it into the corresponding Week cell for that Ref in Sheet 1. Below is what my data is going to look like:

Sheet 2
The columns with "..." in them have data but aren't relevant for what I'm trying to do. There are potentially an unlimited number of rows and I would like to find the total Cost for each unique reference in Column B

Book1
	A	B	C	D	E	F	G	H
1
2
3		Ref	…	…	Cost	Date	CW	…
4		001			£ 1.00	02/01/2021	1
5		001			£ 2.00	07/01/2021	2
6		003			£ 3.00	12/01/2021	3
7		005			£ 4.00	12/01/2022	3
8		003			£ 5.00	13/01/2022	3
9		002			£ 6.00	05/02/2022	6
10		003			£ 7.00	06/02/2022	6
11		004			£ 8.00	06/02/2022	6
BOM

Sheet 3
This is what I want the end result to look like. I can do it with a formula but it needs to be in VBA. Can someone help a novice?

Book1
	A	B	C	D	E	F	G	H	I	J
1
2					Month	Jan	Jan	Jan	Jan	Feb
3		Ref	…	…	WK.	1	2	3	4	5
4		001				100	100	0	0	0
5		002				0	0	0	0	100
6		003				0	0	200	0	100
7		004				0	0	100	0	0
8		005				0	0	0	0	100
Sheet3

Cell Formulas
Range	Formula
F2:J2	F2	=TEXT(DATE(YEAR(NOW()),1,F3*7-2),"mmm")
F4:J8	F4	=SUMIFS(BOM!E4:E11,BOM!B4:B11,Sheet3!B4:B8,BOM!G4:G11,Sheet3!F3:J3)
Dynamic array formulas.

 

[offthelip]

this is quite tricky to do with vba, I have used arrays and the dictionary object which is used to find the unique values. This works with you sample data it does treat "3" and "003" as different items

Sub test()
Dim dict As Object
Set dict = CreateObject("scripting.dictionary")
Dim temparr() As Variant
Dim outarr()
With Worksheets("BOM")
lastrow = .Cells(Rows.Count, "B").End(xlUp).Row   ' find last row of data
inarr = .Range(.Cells(1, 1), .Cells(lastrow, 7))     ' load the whole sheet of data into variant array ( 7 columns)
' find maximum week no
cwmax = 0
 For i = 4 To lastrow
   If inarr(i, 7) > cwmax Then
    cwmax = inarr(i, 7)
   End If
 Next i


 For i = 4 To lastrow
   If dict.exists(inarr(i, 2)) Then
     Erase temparr
     ReDim temparr(1 To cwmax)  ' to pass values to dictionary
     temparr = dict.Item(inarr(i, 2)) ' load dictionary item into temp array
     temparr((inarr(i, 7))) = temparr(inarr(i, 7)) + inarr(i, 5)  ' add cost to total using week no as index
     dict.Item(inarr(i, 2)) = temparr  ' write tempory array back to dictionary
   Else
     Erase temparr
     ReDim temparr(1 To cwmax)  ' to pass values to dictionary
     temparr(inarr(i, 7)) = inarr(i, 5)   ' add first cost into total using week no as index
     dict.Add inarr(i, 2), temparr()
    End If
 Next i
End With
' output dictinary vlaues
 ReDim outarr(1 To lastrow, 1 To 5 + cwmax) '' define output array as the maximu possible size
indi = 1
For Each Key In dict
     Erase temparr
     ReDim temparr(1 To cwmax)  ' to pass values to dictionary
      temparr = dict.Item(Key)
     For j = 1 To cwmax
       outarr(indi, 4 + j) = temparr(j)
     Next j
     outarr(indi, 1) = Key
     indi = indi + 1
Next Key
With Worksheets("Sheet3")
.Range(.Cells(4, 2), .Cells(4 + indi, 5 + cwmax)) = outarr
End With
End Sub

 

[Akira181]

Thanks for this, you're an utter legend! Spent most of yesterday trying to figure this out, I didn't stand a chance. I didn't realise this would be so complicated.

I think I'm being really stupid here but I can't seem to get the macro to output anything. I've copied and pasted the code the worksheet change code for BOM but I'm not seeing anything on sheet3. Have I pasted it into the wrong place?

 

[Akira181]

actually, got it working, I made a typo when I renamed sheet3. Knew I was doing something stupid. One request, can you make it so the output on "Sheet3" only writes the number values and leaves columns B to E alone?

There's data in there that this macro is writing over / deleting

 

[Akira181]

I've been modifying/playing with the code (unsuccessfully) and I'm wondering if there's been a misunderstanding. The summed values from the BOM need to go into the corresponding lines in Sheet3 that match the Ref & CW. It looks like the summed values are going into the correct CW cell but rows are being overwritten entirely?

Mainly because there will be REFs in Sheet3 that do not appear in the BOM until a future date so the row structure of sheet 3 needs to stay the same

 

[offthelip]

I did misunderstand: I hadn't realised that you wanted the output matched to Ref which already existed on Sheet 3. The basic code will work, it is just the output that needs to change. I will have look at this a bit later, it shouldn't be any probelm to do that.

 

[Akira181]

Great, thank you.

I don't even know where to begin on this one

 

[offthelip]

here you are:

Sub test()
Dim dict As Object
Set dict = CreateObject("scripting.dictionary")
Dim temparr() As Variant
'Dim outarr()
With Worksheets("BOM")
lastrow = .Cells(Rows.Count, "B").End(xlUp).Row   ' find last row of data
inarr = .Range(.Cells(1, 1), .Cells(lastrow, 7))     ' load the whole sheet of data into variant array ( 7 columns)
' find maximum week no
cwmax = 0
 For i = 4 To lastrow
   If inarr(i, 7) > cwmax Then
    cwmax = inarr(i, 7)
   End If
 Next i


 For i = 4 To lastrow
   If dict.exists(inarr(i, 2)) Then
     Erase temparr
     ReDim temparr(1 To 1, 1 To cwmax)  ' to pass values to dictionary defein a two dimensional so it can be written to worksheet
     temparr = dict.Item(inarr(i, 2)) ' load dictionary item into temp array
     temparr(1, (inarr(i, 7))) = temparr(1, inarr(i, 7)) + inarr(i, 5) ' add cost to total using week no as index
     dict.Item(inarr(i, 2)) = temparr  ' write tempory array back to dictionary
   Else
     Erase temparr
     ReDim temparr(1 To 1, 1 To cwmax)  ' to pass values to dictionary defein a two dimensional so it can be written to worksheet
     temparr(1, inarr(i, 7)) = inarr(i, 5)  ' add first cost into total using week no as index
     dict.Add inarr(i, 2), temparr()
    End If
 Next i
End With
' output dictionary vlaues

With Worksheets("Sheet3")
lastrowb = .Cells(Rows.Count, "B").End(xlUp).Row   ' find last row of data
refarr = .Range(.Cells(1, 2), .Cells(lastrowb, 2))     ' load the existing refs into a variant array (col B)
For Each Key In dict
     For i = 4 To lastrowb
      If Key = refarr(i, 1) Then  ' find ref which matches key
        Erase temparr
        ReDim temparr(1 To 1, 1 To cwmax)  ' to pass values to dictionary defein a two dimensional so it can be written to worksheet
        temparr = dict.Item(Key)
        .Range(.Cells(i, 6), .Cells(i, 5 + cwmax)) = temparr
        Exit For
      End If
    Next i
Next Key
End With
End Sub

Note if the Refs is on the BOM sheet and is NOT on sheet 3 then nothing is written to sheet 3
Don't worry about not understanding this code at this point, it is using variant arrays and a dictionary object. Both of these are very useful techniques for writing super fast complex operations in VBA. I suggest getting up to speed with variant arrays first , They are very easy to use and often can make your code over 1000 times faster. Once you have got to grips with variant arrays, Dictionaries are just another step, I always like to think of them as being an array with a variable index instead of an integer index. However this application is even more complicated because I am storing a variant array as the item in a dictionary.

 

[Akira181]

Just noticed I didn't reply last week, must have closed my browser too quickly.

That code worked a treat, thank you again!

 

[offthelip]

Glad to be of help. I did realise after I had written the code that it could be slightly more efficient when writing out the results by looping through the refarr first, however if the code works then the lack of perfection is probably irrelevant.