Thread: Macro to delete duplicates based on condition

I've searched far and wide but not finding any VBA that meets my requirements, so any help would be greatly appreciated.

I need to go through all rows and compare rows that all have the same value in one column (Number col in the e.g. below) but delete the rows with date outside of the next 30 days (Date col in the eg below).

Hope I haven't confused you but here is an example to demonstrate the above:

ID Date Number Name
***********************************************
1 13-Mar 16 Dan <------- Keep this row
2 15-May 16 Eric <------- Delete this row
3 3-Feb 16 Kevin <------- Delete this row
4 30-Apr 13 Mike
5 4-Feb 13 John

Appreciation in advance.

Understood, sorry I wasn't clear.

The criteria to delete a row would be:

dateincell < Date or dateincell > Date + 30

so less before today or later than 30 days from now.

Hope this provides clarity.

Thanks,

C

That's correct.

Now multiple rows can have the same number in col A but with different dates in col B.

Number Date
1 3/31
1 4/15
1 6/30

I just want to be left with one row for each number, and that row should be the one with a date 'within' the next 30 days. So using the example above I would be left with:

Number Date
1 4/15

The only caveat is - if there is only one row with Number 2 in col A then leave it alone no matter what date is in col B for that row.

Hope this makes sense. Thanks for your patience.

I've come up with this so far, however:

- It compares col B of 2nd row with col B of 1st row to find duplicates
- Then if its a dupe will delete the 2nd row if it meets the date criteria in col A (< today or > 30 days from now)
- So when it removes the dupes no matter the date in the first row it will never delete it because it doesn't pass the first if statement, which compares the values in Col B. Damn I hope I'm making some sense here :

Sub DeleteDupes()
Dim Iloop As Integer
Dim Numrows As Integer

'Turn off warnings, etc.
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Numrows = Range("A20").End(xlUp).Row
Range("A1:B" & Numrows).Select
For Iloop = Numrows To 2 Step -1
'If value in col B of 2nd row is = value in col B of 1st row
If Cells(Iloop, "B") = Cells(Iloop - 1, "B") Then
'If value (date) in col A of 2nd row is < today or > 30 days from now
If Cells(Iloop, "A") < Date Or Cells(Iloop, "A") > Date + 30 Then
'Delete 2nd row
Rows(Iloop).Delete
End If
End If
Next Iloop

'Turn on warnings, etc.
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

The only caveat is - if there is only one row with Number 2 in col A then leave it alone no matter what date is in col B for that row.

Now I'm really confused .. your orginal example had a "2" in the first column and you indicated to delete it. Also do you litterally mean "2" or do you mean any record with a unique value in Column A ?

Having implemented a similar workaround the macro takes forever given the number of rows of data I have.

Based on all the data sorted by Date:Ascending...

Is there a way I can select all rows that contain a date < today and then just clear the contents of those rows?

That will do the job nicely, just looking for the fastest and most efficient method of doing this as opposed to looping through every line comparing the date and then clearing the contents of that row, which takes forever.

...and not to confuse things any further , disregard any of my requirements outlined in the thread above.

All I need to wrap this up:

After filtering all rows by date, is there a way I can select all the rows that contain a date < today and then just clear the contents of those rows?

Thanks, nearly resolved

Thank you Sir, that did the job nicely.

I appreciate your time and effort.