Code to subtotal duplicate invoice numbers corresponding amounts

[John T]

Hi, could somebody help me with a code for the following.

I have invoice numbers in column A and amounts in column B.
The problem i have is i might have duplicate invoice numbers in column A and different amounts in column B.
Is there a code i could use to reduce the duplicat entries to one entry with a sub total of all of those duplicate amounts.

E.G.

INV Amount
1234 500
1234 1000
1234 1000

Would change to one line of

INV Amount
1234 2500

In addition to that if the sub total is zero could the line be deleted?

 

[LazyBug]

Hello!

Try this:

Private Sub jt()
Dim a, i, sh As Worksheet
    With CreateObject("Scripting.Dictionary")
        a = ActiveSheet.Range("A1").CurrentRegion.Value
        If Not IsEmpty(a) Then
            For i = 2 To UBound(a)
                .Item(a(i, 1)) = .Item(a(i, 1)) + a(i, 2)
            Next i
        End If
     
        For Each i In .keys
            If .Item(i) = 0 Then .Remove (i)
        Next i
        
        Set sh = Worksheets.Add
        sh.Range("A2").Resize(.Count, 2) = Application.Transpose(Array(.keys, .items))
    End With
End Sub

 

[John T]

Hi, Thanks for your reply.
Your code works for me when i just have data in columns A & B although it inserts a new worksheet.
In my example below i cant get it to work on checking column C for duplicates and subtotaling the amounts in Colum D.
I then want the data kept in the currect sheet, keeping all of the same data as shown below.
Is that possible?

As you can see below on rows 5 & 6 the WIP number is column C is duplicated however the amounts in column D subtotal zero so i would need any WIPs with a zero value after sorting to be deleted.