Check for Duplicates then Sum cells of duplicates

[aileen]

I am checking for duplicates in a workbook. The following is the code I'm
using:

lr = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
For i = lr To 1 Step -1
With ActiveSheet
If Cells(i, 11) = Cells(i + 1, 11) _
And Cells(i, 6) = Cells(i + 1, 6) _
And Cells(i, 4) = Cells(i + 1, 4) _
And Cells(i, 5) = Cells(i + 1, 5) Then
Cells(i, 12) = Cells(i, 3) + Cells(i + 1, 3)
End If
End With
Next

This works if there is only one duplicate entry, but I can have multiple
duplicate entries. I need to sum all of the column C cells for each
duplicate found. Is this possible?

 

[Mike H]

Hi,

I can see what your code is doing but am not clear about the result you
expect.

take this data

Columns
C D E F K L
7 1 2 3 4 ?
9 1 2 3 4

Mike


What do you expect to see in column L

Mike

 

[aileen]

I expect to see 16

Hi,

I can see what your code is doing but am not clear about the result you
expect.

take this data

Columns
C D E F K L
7 1 2 3 4 ?
9 1 2 3 4

Mike


What do you expect to see in column L

Mike

 

[aileen]

Acutally, I need to see 16 in the first row, column L and it would be nice to
be able to then delete the second row

 

[Mike H]

Aileen,

But that's exactly what your code does for this data see the results I got
Columns

a b c d K L
7 1 2 3 4 16
9 1 2 3 4
8 2 3 4 5 17
9 2 3 4 5


The only thing that confuses me is why are you setting the range with column 1
wouldn't column 3 be a better option

lr = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row

If you want to delete the rows without the totals add this to the end of
your code

lr = ActiveSheet.Cells(Rows.Count, 12).End(xlUp).Row
For x = lr To 1 Step -1
If Cells(x, "L").Value = "" Then
Rows(x).EntireRow.Delete
End If

Mike

 

[aileen]

Yes, the code works when there is only one duplicate, but when I have more
than one duplicate I need the original row to keep summing the column c.
Here's an example.

C A B D K L
7 1 2 3 4 24
8 1 2 3 4
9 1 2 3 4
7 1 2 3 5
8 1 2 3 6 17
9 1 2 3 6

In this example I would like to delete rows 2,3, & 6, but not row 4 since it
is not a duplicate. I hope this explains a little better what I am trying to
accomplish.

And thanks for your quick responses.

 

[Mike H]

Aileen,

Now I understand. In practice I wouldn't have started from here had I
understood the problem but having done that the code gets a bit messy but it
seems to do what you want.

Note that the last couple of lines delete the rows with no totals in. You
will have to remove the comments to make them work. Don't do thta until your
sure the code works

Sub standard()
lr = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row
For i = 1 To lr

If Cells(i, 11) = Cells(i + 1, 11) And Cells(i, 6) = Cells(i + 1, 6) _
And Cells(i, 4) = Cells(i + 1, 4) _
And Cells(i, 5) = Cells(i + 1, 5) Then
mytotal = mytotal + Cells(i, 3).Value

End If
'***
If Cells(i + 1, 11) <> Cells(i + 2, 11) And Cells(i + 1, 6) <> Cells(i +
2, 6) _
And Cells(i + 1, 4) <> Cells(i + 2, 4) _
And Cells(i + 1, 5) <> Cells(i + 2, 5) Then

Cells(i + 1, 12) = mytotal + Cells(i + 1, 3).Value
mytotal = 0

End If
Next
'deletes rows with not total in
'lr = ActiveSheet.Cells(Rows.Count, 12).End(xlUp).Row
'For x = lr To 1 Step -1
' If Cells(x, "L").Value = "" Then
' Rows(x).EntireRow.Delete
' End If
'Next
End Sub

Mike

 

[aileen]

Mike,

It's not quite doing what I need, but it's given me some ideas to work with.
Thanks so much for all your help.

Aileen