Excel VBA Combine duplicate rows and add quantities - vba

Question

I have data that looks like this:
Col A | Col B | Col C
name 1| Item 1| 3
name 2| Item 3| 1
name 3| Item 2| 2
name 2| Item 3| 6
name 3| Item 2| 4
name 2| Item 3| 3
And I need a line of code to add the last column of quantities for duplicate rows and then delete the duplicate rows. So the above table should look like this:
Col A | Col B | Col C
name 1| Item 1| 3
name 2| Item 3| 10
name 3| Item 2| 6
I have tried multiple ways from other people's questions, but i keep getting "error: 400".
Here's two examples:
For Each a In tm.Range("B2", Cells(Rows.Count, "B").End(xlUp))
For r = 1 To Cells(Rows.Count, "B").End(xlUp).Row - a.Row
If a = a.Offset(r, 0) And a.Offset(0, 1) = a.Offset(r, 1) And a.Offset(0, 2) = a.Offset(r, 2) Then
a.Offset(0, 4) = a.Offset(0, 4) + a.Offset(r, 4)
a.Offset(r, 0).EntireRow.Delete
r = r - 1
End If
Next r
Next a
With Worksheets("Card Test")
With .Range("b2:e2").Resize(.Cells(.Rows.Count, 1).End(xlUp).Row)
.Copy
With .Offset(, .Columns.Count + 1)
.PasteSpecial xlPasteAll ' copy value and formats
.Columns(2).Offset(1).Resize(.Rows.Count - 1, 2).FormulaR1C1 = "=SUMIF(C1,RC1,C[-" & .Columns.Count + 1 & "])"
.Value = .Value
.RemoveDuplicates 1, xlYes
End With
End With
End With
Also I should mention that I have two worksheets and the button using the macro will be on a different sheet than the data. That seems to be causing issues too.

Answer 1

You could use a FOR loop to solve your issue:
Sub RemoveDuplicates()
Dim lastrow As Long
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
For x = lastrow To 1 Step -1
For y = 1 To lastrow
If Cells(x, 1).Value = Cells(y, 1).Value And Cells(x, 2).Value = Cells(y, 2).Value And x > y Then
Cells(y, 3).Value = Cells(x, 3).Value + Cells(y, 3).Value
Rows(x).EntireRow.Delete
Exit For
End If
Next y
Next x
End Sub

Answer 2

Create a code module in your workbook, by default 'Module1'. Paste the following 3 items into that module, with the Enum declaration at the very top. You can change the enumerations, like NumItem = 3 would make the column in which you have the item's name "C" and NumQty automatically 4 ("D") because it follows in the next line. Right now the columns are A, B, and C.
Private Enum Num
NumName = 1 ' Column Names
NumItem
NumQty
NumFirstRow = 2 ' First data row
End Enum
Sub CreateMergedList()
Dim Ws As Worksheet
Dim Comp As String, Comp1 As String
Dim R As Long, Rend As Long, Rsum As Long
Dim Qty As Single
Set Ws = Worksheets("Source")
Ws.Copy Before:=Sheets(1)
With Ws
' There is one caption row which is excluded from sorting
With .UsedRange
.Sort .Columns(NumName), Key2:=.Columns(NumItem), Header:=xlYes
Rend = .Rows.Count
End With
For R = NumFirstRow To Rend - 1
If Comp = vbNullString Then Comp = CompareString(Ws, R)
Comp1 = CompareString(Ws, R + 1)
If StrComp(Comp, Comp1) Then
Comp = vbNullString
Rsum = R + 1
Else
If Rsum = 0 Then Rsum = NumFirstRow
Qty = .Cells(Rsum, NumQty).Value
.Cells(Rsum, NumQty).Value = Qty + .Cells(R + 1, NumQty).Value
.Cells(R + 1, NumName).Value = ""
End If
Next R
For R = Rend To (NumFirstRow - 1) Step -1
If .Cells(R, NumName).Value = "" Then .Rows(R).Delete
Next R
End With
Application.DisplayAlerts = False
Worksheets(1).Delete
Application.DisplayAlerts = True
End Sub
Private Function CompareString(Ws As Worksheet, R As Long) As String
With Ws.Rows(R)
CompareString = .Cells(NumName).Value & "|" & .Cells(NumItem).Value
End With
End Function
At the top of the main procedure, change the name of the worksheet "Source" to whatever is the name of your own worksheet in which you have Names, Items and Quantities.
The code will first make a copy of the worksheet. Then it will sort it by name and item. After that it will combine the quantities and, finally, delete the superfluous rows.
At the end of the code the copy is deleted. If you want to be prompted to permit deletion, add an apostrophe at the start of the line "Application.DisplayAlerts = False" to make that command ineffective.
Call the procedure "CreateMergedList" from the Click event of whatever button you have for that purpose. Have fun!

Answer 3

you could use Dictionary object
Option Explicit
Sub main()
Dim cell As Range, dataRng As Range
Dim key As Variant
With Worksheets("Card Test")
Set dataRng = .Range("A1", .Cells(.Rows.count, "A").End(xlUp))
End With
With CreateObject("Scripting.Dictionary")
For Each cell In dataRng
key = cell.Value & "|" & cell.Offset(, 1).Value
.item(key) = .item(key) + cell.Offset(, 2).Value
Next
dataRng.Resize(, 3).ClearContents
dataRng.Resize(.count) = Application.Transpose(.Keys)
dataRng.Resize(.count).Offset(, 2) = Application.Transpose(.Items)
dataRng.Resize(.count).TextToColumns DataType:=xlDelimited, Other:=True, OtherChar:="|"
End With
End Sub