Delete duplicates and sum values macro

[nedy_03]

Hello,

I have from u guys a macro that delets the rows that have the same value on a column.

Public Sub ProcessData()
Const TEST_COLUMN As String = "A"
Dim i As Long
Dim iLastRow As Long
Dim cell As Range
Dim sh As Worksheet
Dim rng As Range

With ActiveSheet

iLastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = 2 To iLastRow
If Application.CountIf(.Cells(1, "D").Resize(i), .Cells(i, "D")) > 1 Then
If rng Is Nothing Then
Set rng = .Rows(i)
Else
Set rng = Union(rng, .Rows(i))
End If
End If
Next i

End With

If Not rng Is Nothing Then rng.Delete

End Sub

What I would need added to this code ... Let's say we have this situation :

On D2 I have a certain value, let's say "A" ... And on D4, D8 and DX I have the same value "A". In this moment the code it delets the rows 4,8 and X

I would need it to add to the F2 the values from F4, F8 and FX { (sum(F2,F4,F8,FX) }, and to the G2 the the values from G4, G8 and GX.

Can u help me on this, pls!?

Thx,
Nedy

[Bob Phillips]

Public Sub ProcessData()
Const TEST_COLUMN As String = "A"
Dim i As Long
Dim iLastRow As Long
Dim cell As Range

With ActiveSheet

iLastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
.Columns(7).Insert
For i = 2 To iLastRow
.Cells(i, 7).FormulaR1C1 = "=SUMIF(C4:C4,RC4,C6:C6)"
If Application.CountIf(.Cells(1, "D").Resize(i), .Cells(i, "D")) > 1 Then
If rng Is Nothing Then
Set rng = .Rows(i)
Else
Set rng = Union(rng, .Rows(i))
End If
End If
Next i

.Columns(7).Value = Columns(7).Value
.Columns(6).Delete
End With

If Not rng Is Nothing Then rng.Delete

End Sub