Find duplicates rows, sum cells then remove duplcate rows

Hi All,

I am looking for a macro that will check the the values in 2 columns and if a match is found sum up the qty in another column and put this value in the row what will be kept before removing the duplicated rows.

The attached file shows the data and the result expected, my current file is 40k rows and will grow.

If col B & col C are the same
Add up the values of col N, based on different dates in Col O
Put the SUM of col N duplicate rows into the row with the newest (latest) date in col O
Remove duplicate rows
The qty Ordered col G should total the Made qty col N and the Shipped qty col E

Any help would be appreciated

If you need clarification on anything please let me know.
Thank you

Hi Holger

Thanks for your reply.

Sorry I autofilled down when I changed the customer name for the sample data, in reality it would be the same customer for the same order number.

For the same order and line number the only things will change is the ship date , the ship qty, produce date and produced qty.

The file shows duplicate records if there has been more than one shipment made against the same order and line number and also duplicates if the qty produced was a partial qty of the order.

So in rows 22 to 27 on the Data sheet it shows 6 rows of data. There is only 2 actual shipments of 24pcs & 72pcs made on the same day which total 96pcs as per the ordered qty column G, but because these 96pcs took 3 days to complete is shows 6 times (3 times for every shipment made).

The dates completed were
6 12-Sep-12
36 06-Sep-12
54 11-Sep-12

So I would want the row that is remaing to show

Ship Date = last date shipped ( to complete the order total)
Ship qty = 96
Produced Qty = 96
Produced Date = 12th Sept
All other columns details would remain the same.

Thanks
Elaine

Thanks Holger,

I have tested the code and unfortunately is does not give me the desired result.

On the rows 22 to 27, it reduces the 6 rows to 2.

The shipped qty shows one row with 24pcs shipped and one row with 72pcs shipped, this should be one row with 96pcs shipped, if the ship date is different it should use the newest date.

The qty produced left me with one row of 6pcs made for the 12th Sept and one row with 192pcs for the 11th Sept, this should have been one row with 96pcs made for the 12th Sept

I am assuming the 192pcs comes from the original data

6 12-Sep-12
36 06-Sep-12
54 11-Sep-12
6 12-Sep-12
36 06-Sep-12
54 11-Sep-12

So I assume the codes needs to add the qty in Column O if the date in Col N is different.

If only 2 rows of data were duplicated then both rowa are still showing after the code has run, but the produced qty does change to the correct qty on the 2nd row, so it needs to still delete one of the rows.

The uniques criteria needs to be against Col B and Col C as the same orders can be used but with a different line number, its only when col B & col C are the same that is considered as duplicate.

Thanks for the help so far and hope you can assist me further.
Rgards, Elaine

Try this:-
NB:- Test on Trial data, this code will alter the sheet values and remove duplicates.

Sub MG21Sep42
Dim Dn As Range
Dim Temp As String
Dim Rng As Range
Dim nRng As Range
Dim Dic As Object
Dim oDup As String
Dim Q
Dim DelRng As Range
Dim k As Variant
Dim p As Variant
Dim c As Long
Dim oSum As Double
  Application.ScreenUpdating = False
Set Rng = Range(Range("B2"), Range("B" & Rows.Count).End(xlUp))
 Set Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = 1
   For Each Dn In Rng
        oDup = Dn & Dn.Offset(, 1)
            If Not Dic.Exists(oDup) Then
                 Set Dic(oDup) = CreateObject("Scripting.Dictionary")
            Else
                    If DelRng Is Nothing Then
                        Set DelRng = Dn
                    Else
                        Set DelRng = Union(DelRng, Dn)
                    End If
            End If
      
            If Not Dic(oDup).Exists(Dn.Offset(, 13).Value) Then
                Dic(oDup).Add (Dn.Offset(, 13).Value), Dn.Offset(, 12)
            End If
    Next Dn
  
   For Each k In Dic.Keys
        If Dic(k).Count > 1 Then
            For Each p In Dic(k)
               c = c + 1
               If c = 1 Then Set nRng = Dic(k)(p)
                oSum = oSum + Dic(k).Item(p)
           Next p
                nRng.Value = oSum
                    nRng.Offset(, -9) = oSum
                        Set nRng = Nothing
                            c = 0
                                oSum = 0
                End If
    Next k
If Not DelRng Is Nothing Then DelRng.EntireRow.Delete
Application.ScreenUpdating = True
End Sub

Regards Mick

Try Adding the line in red, That show add the date to column "A".

nRng.Value = oSum
                    nRng.Offset(, -9) = oSum
                      nRng.Offset(, 1) = DtMax
                        nRng.Offset(, -13) = DtMax  
                        Set nRng = Nothing
                             c = 0
                                oSum = 0
                                  DtMax = 0