Adding Rows Together as long as Cell Equals Same Value

Question

I have a problem I am working on for my job. I was given a spreadsheet that lists companies in column B and total units sold per transaction in column A. There are over 3000 lines and about 200 companies.

I need to be able to add all of column A for each set of companies listed in column B.

I can't figure out how to use Range.Find in VBA to do what I need.

Answer 1

Sum Up Unique Using a Dictionary

• Here's a more efficient approach. It returns the result in another worksheet.

Option Explicit

Sub CreateUniqueTable()
    
    ' Source range to an array.
    
    Dim sws As Worksheet: Set sws = ThisWorkbook.Worksheets("Sheet1")
    
    Dim lRow As Long
    lRow = sws.Cells(sws.Rows.Count, "B").End(xlUp).Row
    
    Dim srg As Range: Set srg = sws.Range("A1:B" & lRow)
    Dim sData As Variant: sData = srg.Value
    
    ' Array to a dictionary (unique and sum).
    
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare
    
    Dim Key As Variant
    Dim r As Long
    
    For r = 2 To UBound(sData)
        dict(sData(r, 2)) = dict(sData(r, 2)) + sData(r, 1)
    Next r
    
    Dim rCount As Long: rCount = dict.Count + 1
    
    ' Dictionary to another array.
    
    Dim dData As Variant: ReDim dData(1 To rCount, 1 To 2)
    
    ' Write headers.
    dData(1, 1) = sData(1, 2)
    dData(1, 2) = sData(1, 1)
    Erase sData
    
    r = 1
    
    ' Write data.
    For Each Key In dict.Keys
        r = r + 1
        dData(r, 1) = Key
        dData(r, 2) = dict(Key)
    Next Key
    
    ' Array to the destination range.
    
    Dim dws As Worksheet: Set dws = ThisWorkbook.Worksheets("Sheet2")

    With dws.Range("A1").Resize(, 2)
        .Resize(rCount).Value = dData
        .Resize(dws.Rows.Count - .Row - rCount + 1).Offset(rCount).Clear
    End With
    
    ' Inform.
    
    MsgBox "Unique table created.", vbInformation
    
End Sub

Answer 2

I know you asked for a VBA solution but I thought I'd offer a formula approach just in case you find it useful.

First, create a list of unique company names. Reference this link for more info, see option #2.

Enter formula array (D3) by hitting Ctrl+Shift+Enter when entering formula. Drag formula down until all companies are listed.

{=IFERROR(INDEX($B$3:$B$17,MATCH(0,COUNTIF($D$2:D2,$B$3:$B$17),0)),"")}

Now use SumIf in column E to sum shipped quantity. Cell formula E3 shown:

=SUMIF(B:B,D3,A:A)

Results