Excel VBA Combine duplicate rows and add quantities

Spe*_*ery 4 excel vba sum duplicates

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
Run Code Online (Sandbox Code Playgroud)

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
Run Code Online (Sandbox Code Playgroud)

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
Run Code Online (Sandbox Code Playgroud)

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.

VBA*_*ete 5

您可以使用FOR 循环来解决您的问题:

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
Run Code Online (Sandbox Code Playgroud)