Sum duplicate values then delete duplicate rows

[allison]

Hi,

I have searched the archives and have found some great stuff, but am still having some troubles.

I have 4 columns in my spreadsheet. I am trying to find any duplicates that may exist in Col A, sum values in Col D, then delete the entire row. So far my sheet before I run my vba code is this.

Col A
100
101
102
105
100
101
102
105

Col D
5
4
2
4
1
2
3
1


After my code is run, I need for my spreadsheet to look like this
Col A
100
101
102
105

Col D
6
6
5
5


I have some code but I still need to do a considerable amount of tweaking to it. Currently my code is only deleting the duplicate values in Col A. I am having difficulty summing the values in Col D as well as deleting the entire row.

Although I have been working with vba on and off for a few months, I am still a beginner.

Any help that you can provide would be most appreciative.

Here is my code thus far....

-------
Public Sub FindDuplicates()
For RwCnt = 1 To (Worksheets(1).Cells(65536, 1).End(xlUp).Row)

SrchValue = Worksheets(1).Cells(RwCnt, 1).Value
If Len(Trim(SrchValue)) > 0 Then
With Worksheets(1).Range("a1:a" & Cells(65536, 1).End(xlUp).Row)
Set c = .Find(SrchValue, LookIn:=xlValues, Lookat:=xlWhole)
If Not c Is Nothing Then
firstAddress = c.Address
Do
If c.Address <> firstAddress Then c.Clear
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
End If

Next RwCnt
End Sub
------

 

[ttat01]

Try this:

Sub Test()
    Dim Sh As Worksheet
    Dim LastRow As Long
    Dim Rng As Range
    Set Sh = Worksheets(1)
    Sh.Columns(5).Insert
    LastRow = Sh.Range("A65536").End(xlUp).Row
    With Sh.Range("A1:A" & LastRow).Offset(0, 4)
        .FormulaR1C1 = "=IF(COUNTIF(R1C[-4]:RC[-4],RC[-4])>1,"""",SUMIF(R1C[-4]:R[" & LastRow & "]C[-4],RC[-4],R1C[-1]:R[" & LastRow & "]C[-1]))"
        .Value = .Value
    End With
    Sh.Columns(4).Delete
    Sh.Rows(1).Insert
    Set Rng = Sh.Range("D1:D" & LastRow + 1)
    With Rng
        .AutoFilter Field:=1, Criteria1:="="
        .SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End With
End Sub

amazing formula...this code helped me very much. Thank you!

 

[Tarek_CTG]

Sorry for disturbing. Can anyone help me here please?

http://www.mrexcel.com/forum/excel-...tes-using-visual-basic-applications-code.html