Sum Column B based on Column A using Excel VBA Macro - vba

Question

OK, I have a simple problem that I need help with in a VBA Macro. I have an excel sheet that looks like this...
Product # Count
101 1
102 1
101 2
102 2
107 7
101 4
101 4
189 9
I need a macro that adds up the "count" column based on the Product Number Column. I want it to over all look like this after I am done...
Product # Count
101 7
102 7
107 7
189 9
I am an amiture to VBA so I would love any help I can get.

Answer 1

Assuming the data is in columns A and B, you can do it with a formula:
=SUMIF(A:A,101,B:B)
Or if you put 101 in C1:
=SUMIF(A:A,C1,B:B)
EDIT
However if you still require VBA, here is my (quick and dirty) proposal - I use a dictionary to keep track of the sum for each item.
Sub doIt()
Dim data As Variant
Dim i As Long
Dim countDict As Variant
Dim category As Variant
Dim value As Variant
Set countDict = CreateObject("Scripting.Dictionary")
data = ActiveSheet.UsedRange 'Assumes data is in columns A/B
'Populate the dictionary: key = category / Item = count
For i = LBound(data, 1) To UBound(data, 1)
category = data(i, 1)
value = data(i, 2)
If countDict.exists(category) Then
countDict(category) = countDict(category) + value 'if we have already seen that category, add to the total
Else
countDict(category) = value 'first time we find that category, create it
End If
Next i
'Copy dictionary into an array
ReDim data(1 To countDict.Count, 1 To 2) As Variant
Dim d As Variant
i = 1
For Each d In countDict
data(i, 1) = d
data(i, 2) = countDict(d)
i = i + 1
Next d
'Puts the result back in the sheet in column D/E, including headers
With ActiveSheet
.Range("D1").Resize(UBound(data, 1), UBound(data, 2)) = data
End With
End Sub

Answer 2

The easiest thing is to use a Pivot Table in this case as Tim suggested.

Answer 3

Here is a VBA solution that uses multidimensional arrays. I noticed you said you are a bit new to VBA so I tried to put some meaningful comments in there. One thing that might look strange is when I redimension the arrays. That's because when you have multidimensional arrays you can only ReDim the last dimension in the array when you use the Preserve keyword.
Here is how my data looked:
Product Count
101 1
102 1
101 2
102 2
107 7
101 4
101 4
189 9
And here is the code. It has the same output as my last answer. Test this in a new workbook and put the test data in Sheet1 with headers.
Option Explicit
Sub testFunction()
Dim rng As Excel.Range
Dim arrProducts() As String
Dim i As Long
Set rng = Sheet1.Range("A2:A9")
arrProducts = getSumOfCountArray(rng)
Sheet2.Range("A1:B1").Value = Array("Product", "Sum of Count")
' go through array and output to Sheet2
For i = 0 To UBound(arrProducts, 2)
Sheet2.Cells(i + 2, "A").Value = arrProducts(0, i)
Sheet2.Cells(i + 2, "B").Value = arrProducts(1, i)
Next
End Sub
' Pass in the range of the products
Function getSumOfCountArray(ByRef rngProduct As Excel.Range) As String()
Dim arrProducts() As String
Dim i As Long, j As Long
Dim index As Long
ReDim arrProducts(1, 0)
For j = 1 To rngProduct.Rows.Count
index = getProductIndex(arrProducts, rngProduct.Cells(j, 1).Value)
If (index = -1) Then
' create value in array
ReDim Preserve arrProducts(1, i)
arrProducts(0, i) = rngProduct.Cells(j, 1).Value ' product name
arrProducts(1, i) = rngProduct.Cells(j, 2).Value ' count value
i = i + 1
Else
' value found, add to id
arrProducts(1, index) = arrProducts(1, index) + rngProduct.Cells(j, 2).Value
End If
Next
getSumOfCountArray = arrProducts
End Function
Function getProductIndex(ByRef arrProducts() As String, ByRef strSearch As String) As Long
' returns the index of the array if found
Dim i As Long
For i = 0 To UBound(arrProducts, 2)
If (arrProducts(0, i) = strSearch) Then
getProductIndex = i
Exit Function
End If
Next
' not found
getProductIndex = -1
End Function

Answer 4

Sub BestWaytoDoIt()
Dim i As Long ' Loop Counter
Dim int_DestRwCntr As Integer ' Dest. sheet Counter
Dim dic_UniquePrd As Scripting.Dictionary
Set dic_UniquePrd = New Scripting.Dictionary
For i = 2 To Sheet1.Range("A" & Sheet1.Cells.Rows.Count - 1).End(xlUp).Row
If dic_UniquePrd.exist(Sheet1.Range("A" & i).Value) <> True Then
dic_UniquePrd.Add Sheet1.Range("A" & i).Value, DestRwCntr
sheet2.Range("A" & int_DestRwCntr).Value = Sheet1.Range("A" & i).Value
sheet2.Range("B" & int_DestRwCntr).Value = Sheet1.Range("B" & i).Value
Else
sheet2.Range("A" & dic_UniquePrd.Item(Sheet1.Range("A" & i).Value)).Value = sheet2.Range("B" & dic_UniquePrd.Item(Sheet1.Range("A" & i).Value)).Value + Sheet1.Range("B" & i).Value
End If
Next
End Sub
This will serve the purpose..
Only thing to remember is to activate "Microsoft Scripting Runtimes" in references.

Answer 5

Based the code in Sub doIt(), is possible in the for Each ycle to retrive also the number of occurence?
Example:
Product # 101 have 4 occurence
Product # 102 have 2 occurence
ecc...

Answer 6

I know it' late... but I've been brought here by Sum up column B based on colum C values and so I post a solution with the same "formula" approach I used there but adapted to this actual need
Option Explicit
Sub main()
With ActiveSheet
With .Range("A:B").Resize(.cells(.Rows.Count, 1).End(xlUp).row) '<== here adjust "A:B" to whatever colums range you need
With .Offset(1).Resize(.Rows.Count - 1)
.Offset(, .Columns.Count).Resize(, 1).FormulaR1C1 = "=SUMIF(C1,RC1,C2)" ' "helper" column: it's the 1st column right of data columns (since ".Offset(, .Columns.Count)")
.Columns(2).Value = .Offset(, .Columns.Count).Resize(, 1).Value 'update "count" with sum-up from "helper" column
With .Offset(, .Columns.Count).Resize(, 1) ' reference to "helper" column
.FormulaR1C1 = "=IF(countIF(R1C1:RC1,RC1)=1,1,"""")" ' locate Product# repetition with blank cells
.Value = .Value 'fix values
.SpecialCells(xlCellTypeBlanks).EntireRow.Delete 'delete rows corresponding to blank cells
.ClearContents ' clear "helper" column
End With
End With
End With
End With
End Sub
it makes use of a "helper" columns, which I assumed could be the one adjacent to the last data columns (i.e.: if data columns are "A:B" then helper column is "C")
should different "helper" column be needed then see comments about how it's located and change code accordingly