Deleting old entries

[artz]

The following code works fine if the data is grouped (not necessarily sorted) by column B (but not necessarily by column A), this code will delete the duplicates rows, but retaining the latest entry (by column A) of each name in column B.

Sub DeleteTheOldies()
Dim RowNdx As Long
For RowNdx = Range("B2").End(xlDown).Row To 2 Step -1
    If Cells(RowNdx, "B").Value = Cells(RowNdx - 1, "B").Value Then
        If Cells(RowNdx, "A").Value <= Cells(RowNdx - 1, "A").Value Then
            Rows(RowNdx).Delete
        Else
            Rows(RowNdx - 1).Delete
        End If
    End If
Next RowNdx

End Sub

Unfortunately, my data in column B is not grouped (don't want it necessarily) to retain the original order.

I would like the code to perform the function described above, i.e., delete the duplicates rows, but retaining the latest entry (by column A) of each name in column B without having the data grouped.

Also, I need at the same time to delete the same rows that are removed in columns C, D, and E?

Can the code be modified to do this?

Thanks,

Art

 

[Domenic]

Try...

Sub DeleteTheOldies()

Dim wf As WorksheetFunction
Dim LastRow As Long
Dim i As Long

Set wf = Application.WorksheetFunction
LastRow = Range("B2").End(xlDown).Row

Application.ScreenUpdating = False

For i = LastRow To 2 Step -1
    If wf.CountIf(Range(Cells(i, 1), Cells(LastRow, 1)), Cells(i, 1)) > 1 Then
            Rows(i).Delete
    End If
Next

Application.ScreenUpdating = True

End Sub

 

[artz]

Hi Domenic,

Thanks for your posting and code. I did try your code and it didn't quite do what I had in mind. Below is and input and ouput for what I am looking for. Maybe that will help:

Input:
A                B      C      D       E
12/12/09	yyyy	 a	b	c
12/13/09	jjjj	 d	e	f
12/14/09	krr	 g	h	i
12/15/09	yyyy	 j	k	l
12/16/09	yyyy	 m	n	o
12/17/09	jjjj	 p	q	r
12/18/09	jjjj	 s	t	u
12/19/09	jjjj	 v	w	x
12/20/09	krr	 y	z	aa

Output:

12/16/09	yyyy	 m	n	o
12/19/09	jjjj	 v	w	x
12/20/09	krr	 y	z	aa

I apologize if using code tags this way is not suggested, however, it keeps the columns formatted to better illustrate what I need.

Please let me know if you have any questions.

Thanks,

Art

 

[Domenic]

Try...

    If wf.CountIf(Range(Cells(i, [COLOR="Red"]2[/COLOR]), Cells(LastRow, [COLOR="red"]2[/COLOR])), Cells(i, [COLOR="red"]2[/COLOR])) > 1 Then

 

[artz]

Hi Domenic,

Thanks for your reply. I don't quite understand how to implement the code snippet that you posted. Could you provide more details? I think that you are suggesting that the code be added to your previous post. If that's the case, I don't know how it fits in.

Thanks,

Art

 

[artz]

Hi Domenic,

I guess that I should wait until I fully wake up before I post. Your code snippet placed in your previous code works perfectly.

Thanks so much,

Art

 

[Domenic]

You're very welcome!

 

[artz]

Domenic,

Yikes, I just deleted the wrong stuffwhen I ran your code. . The data that need to be deleted are on Sheet2 not Sheet1.

Could you modify your code to operate on Sheet2's data, not Sheet1?

Thanks,

Art

 

[artz]

Domenic,

I tried modifying your code to operate on Sheet2 instead of Sheet1. When I run it, I get an error 400.

Do you see what's wrong?

Sub DeleteTheOldies()

Dim wf As WorksheetFunction
Dim LastRow As Long
Dim i As Long

Set wf = Application.WorksheetFunction
LastRow = Sheet2.Range("B2").End(xlDown).Row

Application.ScreenUpdating = False

For i = LastRow To 2 Step -1
    If wf.CountIf(Sheet2.Range(Cells(i, 2), Cells(LastRow, 2)), Cells(i, 2)) > 1 Then
            Rows(i).Delete
    End If
Next

Application.ScreenUpdating = True

End Sub

Thanks,

Art

 

[Domenic]

Try...

Sub DeleteTheOldies2()

Dim wf As WorksheetFunction
Dim LastRow As Long
Dim i As Long

Set wf = Application.WorksheetFunction
LastRow = Worksheets("Sheet2").Range("B2").End(xlDown).Row

Application.ScreenUpdating = False

For i = LastRow To 2 Step -1
    With Worksheets("Sheet2")
        If wf.CountIf(Range(.Cells(i, 2), .Cells(LastRow, 2)), .Cells(i, 2)) > 1 Then
            .Rows(i).Delete
        End If
    End With
Next

Application.ScreenUpdating = True

End Sub