Excel - Delete duplicate rows based on a date

[DrSmyth]

My report has 6 Columns (A:F) However column F has some duplicated information (It's in the form of an 8 digit alpha/numeric code). In column C of the report is a date, each duplicated item in column F will have a different date.

I want to go through the report and delete all duplicated rows except for the one with the earliest date EG:

C F
01/01/2003 1234567d
02/01/2003 1234567d
05/07/2003 2345678a
09/08/2003 2345678a
10/08/2003 2345678a
01/03/2003 3456789b

Should read

C F
01/01/2003 1234567d
05/07/2003 2345678a
01/03/2003 3456789b

Can anybody help?

 

[chandlm]

DrSmyth,

What column is your sheet sorted by?



Matt

 

[Bowers74]

DrSmyth,

Sort your data by Date in Ascending order and run the following:

Sub DeleteDupes()
Dim c As Range, SearchRange As Range
Set SearchRange = Range([F2], [F2].End(xlDown))
On Error Resume Next
For Each c In SearchRange
    If c = c.Offset(-1, 0) Then c.EntireRow.Delete shift:=xlUp
Next c
End Sub

Save your work first, just in case I misunderstood you.

I hope this helps!!!

Peace!

Mike

Never say Never!!!
Nothing is impossible!!!

 

[DrSmyth]

ChandLM, my data is sorted by Column A (Name), then Column F (Code) and then Columc C (date)..

Bowers, I've pasted your code into the sheet code window and it doesn't seem to delete anything....

 

[DrSmyth]

Bowers,

Sorry, I've just pasted your code into a module, and now it works for the sctive sheet, but i have have to run it a few times to fully delete all of the duplicates.

 

[RooSXL]

Bowers,

Is there a way that it will loop itself until it takes care of all the duplicates.

Sub DeleteDupes()
Dim c As Range, SearchRange As Range
Set SearchRange = Range([F2], [F2].End(xlDown))
On Error Resume Next
For Each c In SearchRange
    If c = c.Offset(-1, 0) Then c.EntireRow.Delete shift:=xlUp
Next c
End Sub

I have a file that sometimes has a more than ten duplicates in it takes sometime. A loop would be good because it would delete duplicates automatically while the person can do some other things.

I would appreciate the help.

 

[PHV]

When you delete rows, always browse from last row to first:
lastR = [F2].End(xlDown).Row
For R = lastR - 1 To 1 Step -1
If Cells(R, "F") = Cells(R + 1, "F") Then Cells(R, "F").EntireRow.Delete shift:=xlUp
Next R


Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ222-2244