If columns D and E match, delete a row with oldest date(in column B) VBA

[Lenna]

Hello,

I need to compare values in columns D and E with a row beneath. If they match, I would like keep a row with the most recent date(column B) and delete the other. All data are sorted and duplicates are removed.

Here is how far I got with the code... . Please suggest the rest.

Sub MostRecentDate()
Dim lr As Long, r As Long
lr = Cells(Rows.Count, "A").End(xlUp).Row
For r = 2 To lr + 1
    If
        Range("D" & r).Value = Range("D" & r + 1).Value And _
        Range("E" & r).Value = Range("E" & r + 1).Value Then
        'some code
       
    End If
    Next r
End Sub

Thanks,

Lenna

 

[JLGWhiz]

Try this on a copy of your file. Note that I changed the sequence of your For...Next statement so that it will start from the bottom and work upward on the sheet. This eliminates the skipping of rows caused by the shifting upon deletion or a row or rows.

Sub MostRecentDate()
Dim lr As Long, r As Long
lr = Cells(Rows.Count, "A").End(xlUp).Row
    For r = lr To 2 Step -1
        If Range("D" & r).Value = Range("D" & r - 1).Value And _
        Range("E" & r).Value = Range("E" & r - 1).Value Then
        'some code
            If Range("B" & r).Value > Range("B" & r -1).Value Then
                Rows(r - 1).Delete xlUp
            Else
                Rows(r).Delete xlUp
            End If
       
        End If
    Next r
End Sub

 

[Lenna]

Thank you, it works great!

Try this on a copy of your file. Note that I changed the sequence of your For...Next statement so that it will start from the bottom and work upward on the sheet. This eliminates the skipping of rows caused by the shifting upon deletion or a row or rows.

Sub MostRecentDate()
Dim lr As Long, r As Long
lr = Cells(Rows.Count, "A").End(xlUp).Row
    For r = lr To 2 Step -1
        If Range("D" & r).Value = Range("D" & r - 1).Value And _
        Range("E" & r).Value = Range("E" & r - 1).Value Then
        'some code
            If Range("B" & r).Value > Range("B" & r -1).Value Then
                Rows(r - 1).Delete xlUp
            Else
                Rows(r).Delete xlUp
            End If
       
        End If
    Next r
End Sub

 

[JLGWhiz]

Thank you, it works great!

You're welcome,
Regards, JLG