VBA Recipe calculator sum the ingredients

[Exceladd1ct]

Hello,

I need a piece of code that will calculate the quantities of needed ingredients for some products but i am stuck with some 2d arrays and the code messed up. Can you please help me?
In the attached images,
-the result for ingredient1 is 40 because we need 20 cakes and we use 2 pcs in each cake.
-the result for ingredient15 is 30 because we use 1 pcs in each cake but it is needed in both cake1 and cake3
-and so on

I will run the code with a button or a shape on the worksheet.
We can asume the columns for RECIPES sheet are A,B,C,D and for CALCULATOR sheet are A,B and E,F,G respectively.

Thank you!

 

[Saurabhj]

Hi,

Use below code:

Sub showCalculation()
Dim totalRows As Integer, rowno As Integer
Dim totalProds As Integer, prodNo As Integer
Dim resultRow As Integer

totalRows = Sheets("Recipes").Cells(Rows.Count, 1).End(xlUp).Row
totalProds = Sheets("Calculator").Cells(Rows.Count, 1).End(xlUp).Row

resultRow = 3

Sheets("Calculator").Range("E3:G" & Cells(Rows.Count, 5).End(xlUp).Row).ClearContents

    For prodNo = 3 To totalProds
        For rowno = 3 To totalRows
            With Sheets("Calculator")
                If .Cells(prodNo, 1) = Sheets("Recipes").Cells(rowno, 1) Then
                    .Cells(resultRow, "E") = Sheets("Recipes").Cells(rowno, 2)
                    .Cells(resultRow, "F") = Sheets("Recipes").Cells(rowno, 3)
                    .Cells(resultRow, "G") = Sheets("Recipes").Cells(rowno, 4) * .Cells(prodNo, "B")
                    resultRow = resultRow + 1
                End If
            End With
        Next
    Next
End Sub

Cake Recipe.xlsm
	A	B	C	D	E	F	G	H
1
2	Product	Quantity			Ingredient	Ingredient ID	Qty Needed
3	Cake2	25			Ingredient2	ID2	25
4					Ingredient8	ID8	50
5					Ingredient9	ID9	25
6					Ingredient16	ID16	50
7
8
9
10
11
12
13
14
15
16
17
Calculator

Cake Recipe.xlsm
	A	B	C	D
2	Product	Ingredients	Ingredient ID	Needed Quantity
3	Cake1	Ingredient1	ID1	2
4	Cake1	Ingredient2	ID2	1
5	Cake1	Ingredient3	ID3	2
6	Cake1	Ingredient15	ID15	2
7	Cake1	Ingredient5	ID5	3
8	Cake1	Ingredient6	ID6	4
9	Cake2	Ingredient2	ID2	1
10	Cake2	Ingredient8	ID8	2
11	Cake2	Ingredient9	ID9	1
12	Cake2	Ingredient16	ID16	2
13	Cake3	Ingredient21	ID21	2
14	Cake3	Ingredient11	ID11	4
15	Cake3	Ingredient22	ID22	3
16	Cake3	Ingredient33	ID33	5
17	Cake3	Ingredient34	ID34	3
Recipes

 

[Exceladd1ct]

Your code works great, but when you add a second product (eg. cake3), instead of summing up the common ingredients, it adds them to the results.
So i had to add a dictionary to your code and now it does the job.

Thank you for your contribution.

Sub showCalculation()
Dim totalRows As Integer, rowno As Integer
Dim totalProds As Integer, prodNo As Integer
Dim resultRow As Integer, new_value As Long

Dim dict As Object

Set dict = CreateObject("Scripting.Dictionary")

totalRows = Sheets("Recipes").Cells(Rows.Count, 1).End(xlUp).Row
totalProds = Sheets("Calculator").Cells(Rows.Count, 1).End(xlUp).Row

resultRow = 3

Sheets("Calculator").Range("E3:G" & Cells(Rows.Count, 5).End(xlUp).Row).ClearContents

    For prodNo = 3 To totalProds
        For rowno = 3 To totalRows
            With Sheets("Calculator")
                If .Cells(prodNo, 1) = Sheets("Recipes").Cells(rowno, 1) Then
                
                    ingredient_name = Sheets("Recipes").Cells(rowno, 2)
                    ingredient_id = Sheets("Recipes").Cells(rowno, 3)
                    ingredient_qty = Sheets("Recipes").Cells(rowno, 4) * .Cells(prodNo, "B")
                    
                    If Not dict.exists(ingredient_name) Then
                        dict.Add ingredient_name, ingredient_qty
                    Else
                        new_value = ingredient_qty
                        dict.Item(ingredient_name) = dict.Item(ingredient_name) + new_value
                    End If
                    
                    resultRow = resultRow + 1
                    
                End If
            End With
        Next
    Next
    
    
Dim key As Variant
For Each key In dict.Keys
    lrow = Sheets("Calculator").Cells(Rows.Count, 5).End(xlUp).Row
    Sheets("Calculator").Cells(lrow + 1, 5).Value = key
    Sheets("Calculator").Cells(lrow + 1, 6).Value = dict(key)
Next key
    
    
End Sub

 

[Saurabhj]

It's great that the problem resolved. Thanks for the feedback.