Unique values in a macro

[kkirank.kmp]

Hello all, I have the sheet with the following data

12 1 01 6
18 1 01 10
12 1 01 6
11 5 09 3
12 1 10 1
12 2 01 12
12 1 01 2
11 5 09 5
11 5 11 23

The data on the last column is the count, I need to get the following
output

12 1 01 12 (sum of row 1 & 3)
18 1 01 10
11 5 09 8 (sum of row 4 & 8)
12 1 10 1
12 2 01 12
12 1 01 2
11 5 11 23

This is what the above results is - data from row1 for colA, colB &
colC is compared with the data with row2: ColA, ColB, ColC, and if
they are same then the data from ColD is summed up. I was trying to do
it through SumProduct, but could not achieve what I was trying to do.
So in the above example row 1 & 3 are same when u compare ColA, ColB &
ColC, so I add up the values in column D. Basically I need unique
values to be selected from ColA, ColB & colC and if there are more
than one row with the same value I need to sum the data in ColD. Hope
I have not confused with too many things. I need this to be done as
part of the macro That I'm creating

Thankyou for any help. Thanks in advance.

 

[Bob Phillips]

Public Sub ProcessData()
Dim i As Long
Dim LastRow As Long
Dim rng As Range
Dim sFormula1 As String
Dim sFormula2 As String

With ActiveSheet

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
sFormula1 = "SUMPRODUCT(--(A1:A" & LastRow & "=A<>)," & _
"--(B1:B" & LastRow & "=B<>)," & _
"--(C1:C" & LastRow & "=C<>)," & _
"D1" & LastRow & ")"
sFormula2 = "SUMPRODUCT(--(A1:A<>=A<>)," & _
"--(B1:B<>=B<>)," & _
"--(C1:C<>=C<>))"
For i = 1 To LastRow

.Cells(i, "D").Value = .Evaluate(Replace(sFormula1, "<>", i))
If .Evaluate(Replace(sFormula2, "<>", i)) > 1 Then

If rng Is Nothing Then

Set rng = .Rows(i)
Else

Set rng = Union(rng, .Rows(i))
End If
End If
Next i

If Not rng Is Nothing Then rng.Delete
End With

End Sub

--
---
HTH

Bob


(there's no email, no snail mail, but somewhere should be gmail in my addy)