Delete row with duplicates but pick one to keep

[SQUIDD]

Hi

Strange one here.

I want to delete duplicates in a column, but keep the one whos date is the most up to date, for example

I have only 2 column of data. column A and column B.

1000 : 02/02/17
1001 : 02/02/17
1002 : 02/02/17
1003 : 01/02/17
1004 : 01/02/17
1002 : 01/02/17

so as you can see, i have in column A a duplicate, 1002, one has a date of 02/02/17 and one has a date of 01/02/17.
so i would like to end up with the oldest date removed. like

1000 : 02/02/17
1001 : 02/02/17
1002 : 02/02/17
1003 : 01/02/17
1004 : 01/02/17

at the most my column will be 100 rows long and have a max number of duplicates of 5.

But i really dont know how to go about achieving this.

Thanks for looking

Dave

 

[FDibbins]

You could use VBA for this, but I would use a helper column to test for your duplicates. Maybe something as simple as this?

	A​	B​	C​
2​	aa	1/1/2017​	FALSE​
3​	bb	1/2/2017​	TRUE​
4​	cc	1/3/2017​	TRUE​
5​	dd	1/4/2017​	TRUE​
6​	aa	1/5/2017​	TRUE​

C2=COUNTIF($A$2:A2,A2)=COUNTIF($A$2:$A$6,A2)
copied down

Then filter the table on the helper column to only show FALSE - delete those rows, and remove the helper if needed

 

[Michael M]

UNTESTED

Sub MM1()
 Dim lr As Long, r As Long
 lr = Cells(Rows.Count, "A").End(xlUp).Row
    Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A2:A" & lr), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("B2:B" & lr), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A1:B" & lr)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
For r = lr To 2 Step -1
    If Range("A" & r).Value = Range("A" & r - 1).Value And Range("B" & r - 1).Value < Range("B" & r).Value Then
        Rows(r - 1).Delete
    End If
Next r
End Sub

 

[JLGWhiz]

Hi

Strange one here.

I want to delete duplicates in a column, but keep the one whos date is the most up to date, for example

I have only 2 column of data. column A and column B.

1000 : 02/02/17
1001 : 02/02/17
1002 : 02/02/17
1003 : 01/02/17
1004 : 01/02/17
1002 : 01/02/17

so as you can see, i have in column A a duplicate, 1002, one has a date of 02/02/17 and one has a date of 01/02/17.
so i would like to end up with the oldest date removed. like

1000 : 02/02/17
1001 : 02/02/17
1002 : 02/02/17
1003 : 01/02/17
1004 : 01/02/17

at the most my column will be 100 rows long and have a max number of duplicates of 5.

But i really dont know how to go about achieving this.

Thanks for looking

Dave

I wrote this to cover a condition where the sheet is unsorted, but it should work on a sorted sheet also. The idea is to compare the values in column B and delete the lesser of the two. When there is only one left, it will be the greater of the original total and will not be deleted.

Sub delDateLessThan()
Dim i As Long, fn As Range
With ActiveSheet
    For i = .Cells(Rows.Count, 1).End(xlUp).Row To 2
        If Application.CountIf(.Range("A:A"), .Cells(i, 1).Value) > 1 Then
            Set fn = .Range("A2", Cells(i - 1, 1).Find(.Cells(i, 1).Value), , xlValue, xlWhole)
                If Not fn Is Nothing Then
                    If fn.Offset(, 1).Value > .Celss(i, 1).Value Then
                        Rows(i).Delete
                    Else
                        fn.EntireRow.Delete
                    End If
                End If
        End If
    Next
End With
End Sub

 

[SQUIDD]

Hi Ford

Thanks for that. Tested and its works fine. Great Job.

Only thing is, i really would like to do it in code as the data arrives on the sheet as a result of code and gets sorted.
One thing i could do i guess is put the formula to into code and put that in the cells if no one has a vba idea.

Thanks ford, you have given me a way forward if needed.

Cheers

dave

 

[FDibbins]

Glad to help.
Both Michael and ALG have given you the code for this

 

[SQUIDD]

Hi Michael

Thanks for the code, for some reason i i cannot execute it, when i click on your macro is greys out the options?

JLGWhiz, i run your code, but none of the duplicates deleted.

thanks to you both.

Dave

 

[JLGWhiz]

Hi Michael

Thanks for the code, for some reason i i cannot execute it, when i click on your macro is greys out the options?

JLGWhiz, i run your code, but none of the duplicates deleted.

thanks to you both.

Dave

That is because I was comparing apples to oranges. See if this does a little better.

Sub delDateLessThan()
Dim i As Long, fn As Range
With ActiveSheet
    For i = .Cells(Rows.Count, 1).End(xlUp).Row To 2
        If Application.CountIf(.Range("A:A"), .Cells(i, 1).Value) > 1 Then
            Set fn = .Range("A2", .Cells(i - 1, 1).Find(.Cells(i, 1).Value), , xlValue, xlWhole)
                If Not fn Is Nothing Then
                    If fn.Offset(, 1).Value > .Celss(i, 1).Offset(, 1).Value Then
                       .Rows(i).Delete
                    Else
                        fn.EntireRow.Delete
                    End If
                End If
        End If
    Next
End With
End Sub

 

[Michael M]

Is your worksheet called "Sheet1" ??
If not, change the references in the macro to suit.

 

[SQUIDD]

Hi JLGWhiz

Tried the new code, still no joy, just making sure, numbers are in A and dates are in B.
Thanks for trying again

Hi Michael
yep, sheet is called sheet1.
macro RUN is greyed out?

Thanks Guys

Dave