views:

27

answers:

1

The worksheet is sorted base on Column A (account number) first and then Column C (date).

I have below script that remove duplicate records and remain the most recent one.

Sub DeleteTheOldies()  
Dim RowNdx As Long  
For RowNdx = Range("a1").End(xlDown).Row To 2 Step -1  
Do While Cells(RowNdx, "a").Value = Cells(RowNdx - 1, "a").Value  
If Cells(RowNdx, "c").Value <= Cells(RowNdx - 1, "c").Value Then  
Rows(RowNdx).Delete  
Else  
Rows(RowNdx - 1).Delete  
End If  
RowNdx = RowNdx - 1  
If RowNdx = 1 Then Exit Sub  
Loop  
Next RowNdx  
End Sub  

Sample data:

Column A     Column B   Column C  
751063031 1605621498 03-JUL-10  
751063031 5600003138 18-JUL-10  
751063031 5600084443 17-AUG-10  
754199715 1605621498 27-FEB-10  
754199715 5600084438 17-AUG-10  
757129104 5600084892 12-NOV-09  
757129104 5600084438 17-AUG-10  
757307416 1605621498 27-FEB-10  
757307416 5600084438 17-AUG-10  

Output of current script:

751063031 5600084443 17-AUG-10  
754199715 5600084438 17-AUG-10  
757129104 5600084438 17-AUG-10  
757307416 5600084438 17-AUG-10  

I need a modified version of the script to give the below output (delete the most recent and remain the rests)

751063031 1605621498 03-JUL-10  
751063031 5600003138 18-JUL-10  
754199715 1605621498 27-FEB-10  
757129104 5600084892 12-NOV-09  
757307416 1605621498 27-FEB-10    
A: 

Try the following. This will work with your example above. If you have additional constraints/requirements, it may need to be adjusted.

Sub NewStuff()

    Dim RowNdx As Long
    Dim CurVal As String

    For RowNdx = 1 To Range("a1").End(xlDown)

        If Cells(RowNdx, "a").Value = Empty Then

            Exit For

        End If

        If Cells(RowNdx, "a").Value <> Cells(RowNdx + 1, "a").Value Then

            Rows(RowNdx).Delete
            RowNdx = RowNdx - 1

        End If

    Next RowNdx

End Sub
Edward Leno