Sum Values based on unique ID - vba

Question

Just started a new job. I'm automating a month-end report and I'm new at VBA. Been googling most of my issues with success, but I've finally run into a wall. In essence I'm downloading some data from SAP and from there I need to build a report.
My question is: How to do a sumif function using loops in VBA?
Data pull:
Sheet1 contains a product code and purchase amounts (columns A & B) respectively. One product code can have several purchases (several rows with the same product code).
Steps so far:
I arranged the data sheet1 to be in ascending order.
Copied unique values for the product codes onto another sheet (sheet2). So Sheet2 has a list of all the products (in ascending order).
I want to get the sum of all purchases in sheet2 column B (per product code). I know how to do this using formulas, but I need to automate this as much as possible. (+ I'm genuinely interested in figuring this out)
This is what I did in VBA so far:
Sub Macro_test()
Dim tb As Worksheet
Dim tb2 As Worksheet
Dim x As Integer
Dim y As Integer
Dim lrow As Long
Set tb = Sheets("sheet1")
Set tb2 = Sheets("sheet2")
lrow = tb.Cells(Rows.Count, "A").End(xlUp).Row
For x = 2 To lrow
For y = 2 To lrow
If tb2.Cells(x, 1).Value = tb.Cells(y, 1).Value Then
tb2.Cells(x, 2).Value = tb.Cells(y, 2).Value
End If
Next y
Next x
End Sub
If i'm not mistaken, for each product_code in sheet2 col A, I'm looping through all the product codes in sheet1 and getting back the LAST value it finds, instead of the sum of all values... I understand why it doesn't work, I just don't know how to fix it.
Any help would be much appreciated. Thanks!

Answer 1

This statement overwrites the value of tb2.Cells(x, 2).Value at each iteration:
tb2.Cells(x, 2).Value = tb.Cells(y, 2).Value
Instead, I think you need to keep adding to it:
tb2.Cells(x, 2).Value = tb2.Cells(x, 2).Value + tb.Cells(y, 2).Value
But I don't like the looks of your double-loop which uses only one lrow variable to represent the "last row" on the two different worksheets, that could be causing some issues.
Or, in your loop do something like this which I think will avoid the duplicate sum. Still, assumes the second worksheet doesn't initially have any value in
' Base our lRow on Sheet2, we don't care how many rows in Sheet1.
lrow = tb2.Cells(tb2.Rows.Count, 1).End(xlUp).Row
Dim cl as Range
Set cl = tb.Cells(2,1) 'Our initial cell value / ID
For x = 2 to lRow '## Look the rows on Sheet 2
'## Check if the cell on Sheet1 == cell on Sheet2
While cl.Value = tb2.Cells(x,1).Value
'## Add cl.Value t- the tb2 cell:
tb2.Cells(x, 2).Value = tb2.Cells(x, 2).Value + cl.Offset(0,1).Value
Set cl = cl.Offset(1) '## Reassign to the next Row
Wend
Next
But it would be better to omit the double-loop and simply use VBA to do 1 of the following:
1. Insert The Formula:
(See Scott Holtzman's answer).
This approach is better for lots of reasons, not the least of which is that the WorksheetFunction is optimized already, so it should arguably perform better though on a small dataset the difference in runtime will be negligible. The other reason is that it's stupid to reinvent the wheel unless you have a very good justification for doing so, so in this case, why write your own version of code that accomplishes what the built-in SumIf already does and is specifically designed to do?
This approach is also ideal if the reference data may change, as the cell formulas will automatically recalculate based on the data in Sheet1.
2. Evaluate the formula & replace with values only:
If you prefer not to retain the formula, then a simple Value assignment can remove the formula but retain the results:
With .Range(.Range("B2"), .Range("A2").End(xlDown).Offset(, 1))
.FormulaR1C1 = "=SUMIF(Sheet1!C[-1]:C[-1],RC[-1],Sheet1!C:C)"
.Value = .Value 'This line gets rid of the formula but retains the values
End With
Use this approach if you will be removing Sheet1, as removing the referents will break the formula on Sheet2, or if you otherwise want the Sheet2 to be a "snapshot" instead of a dynamic summation.

Answer 2

If you really need this automated, take advantage of VBA to place the formula for you. It's very quick and easy using R1C1 notation.
Complete code (tested):
Dim tb As Worksheet
Dim tb2 As Worksheet
Set tb = Sheets("sheet1")
Set tb2 = Sheets("sheet2")
Dim lrow As Long
lrow = tb.Cells(tb.Rows.Count, 1).End(xlUp).Row
tb.Range("A2:A" & lrow).Copy tb2.Range("A2")
With tb2
.Range("A2").CurrentRegion.RemoveDuplicates 1
With .Range(.Range("B2"), .Range("A2").End(xlDown).Offset(, 1))
.FormulaR1C1 = "=SUMIF(Sheet1!C[-1]:C[-1],RC[-1],Sheet1!C:C)"
End With
End With
Note that with R1C1 notation the C and R are not referring to column or row letters . Rather they are the column and row offsets from the place where the formula is stored on the specific worksheet. In this case Sheet!C[-1] refers to the entire A column of sheet one, since the formula is entered into column B of sheet 2.

Answer 3

I wrote a neat little algorithm (if you can call it that) that does what you want them spits out grouped by totals into another sheet. Basically it loops through the first section to get unique names/labels and stores them into an array. Then it iterates through that array and adds up values if the current iteration matches what the current iteration of the nested loop position.
Private Sub that()
Dim this As Variant
Dim that(9, 1) As String
Dim rowC As Long
Dim colC As Long
this = ThisWorkbook.Sheets("Sheet4").UsedRange
rowC = ThisWorkbook.Sheets("Sheet4").UsedRange.Rows.Count
colC = ThisWorkbook.Sheets("Sheet4").UsedRange.Columns.Count
Dim thisname As String
Dim i As Long
Dim y As Long
Dim x As Long
For i = LBound(this, 1) To UBound(this, 1)
thisname = this(i, 1)
For x = LBound(that, 1) To UBound(that, 1)
If thisname = that(x, 0) Then
Exit For
ElseIf thisname <> that(x, 0) And that(x, 0) = vbNullString Then
that(x, 0) = thisname
Exit For
End If
Next x
Next i
For i = LBound(that, 1) To UBound(that, 1)
thisname = that(i, 0)
For j = LBound(this, 1) To UBound(this, 1)
If this(j, 1) = thisname Then
thisvalue = thisvalue + this(j, 2)
End If
Next j
that(i, 1) = thisvalue
thisvalue = 0
Next i
ThisWorkbook.Sheets("sheet5").Range(ThisWorkbook.Sheets("Sheet5").Cells(1, 1), ThisWorkbook.Sheets("Sheet5").Cells(rowC, colC)).Value2 = that
End Sub
Yay arrays