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

 

[artz]

Hi Domenic,

Your latest code produces an "Error 400" when I run it. I specified "Sheet2" in more places in your previous code and it seems to work fine. Is this not the best way to do this? Please see code below:

Sub DeleteTheOldies4()

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(Sheet2.Cells(i, 2), Sheet2.Cells(LastRow, 2)), Sheet2.Cells(i, 2)) > 1 Then
            Sheet2.Rows(i).Delete
    End If
Next

Application.ScreenUpdating = True

End Sub

Thanks,

Art

 

[Domenic]

I don't know why you're getting an error, but when I tested it I didn't get any errors. In any case, your code seems fine.