Deleting Similar Rows using Excel VBA

Question

I am trying to write a VBA code for an Excel macro so that I can manually trigger the macro to do the following:

In the event that any two rows have:

Same value in column A
Same value in Column B
"apple" in Column C
Same value in Column D

Then I would like all of those rows to be deleted except the row with the highest value in column E.

As an example, if:

cell A1 = cell A2
cell B1 = cell B2
cell C1 and Cell C2 = "apple"
cell D1 = cell D2
Cell E1 = 5 and Cell E2 = 10

Then Row 1 gets deleted and Row 2 remains.

The overall goal is to delete similar rows.

Per a user's suggestions, this process can be aided/simplified by sorting range by c="apple",a,b,d so that rows can be analyzed consecutively.

Example of Code Outcome

I put together the following code, but I am unfamiliar with the delete row aspect and how to incorporate the highest value, but this was my best shot. The If and elseif statements are questionable.

Sub Macro()

Dim a As Range
Dim b As Range
Dim c As Range
Dim d As Range
Dim e As Range

For Each a In Range("A1:A9999")

For Each b In Range("B1:B9999")

For Each c In Range("C1:C9999")

For Each d In Range("D1:D9999")

For Each e In Range("E1:E9999")

If a.Offset(-1, 0) = a And b.Offset(-1, 0) And c.Offset(-1, 0) = c And d.Offset(-1, 0) = d And e.Offset(-1, 0) < e Then Range(a).EntireRow.Delete

ElseIf a.Offset(-1, 0) = a And b.Offset(-1, 0) And c.Offset(-1, 0) = c And d.Offset(-1, 0) = d And e.Offset(-1, 0) > e Then Range(a.Offset(-1, 0)).EntireRow.Delete

Exit For

Next a

Next b

Next c

Next d

Next e

End Sub

Actually I realize the code I put together doesn't even make sense... I am working on revising it. The description I wrote is correct, though. — Zachary Snier
Your example compares 2 consecutive rows is this what you want?? — Gary's Student
@Gary'sStudent It compares any of the rows in the document. Not necessarily consecutive rows. — Zachary Snier

Immobilizer Immobilizer · Accepted Answer · 2020-06-08T13:52:20

I hope it works.

Option Explicit

Sub RunMacro()
Dim i As Long, LastRow As Long, j As Long
Dim cellA, cellB, cellC, cellD, cellE
Dim Rng As Range
LastRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To LastRow
cellA = Range("A" & i).Value
cellB = Range("B" & i).Value
cellC = Range("C" & i).Value
cellD = Range("D" & i).Value
cellE = Range("E" & i).Value

For j = LastRow To 2 Step -1
    If Range("A" & j).Value = cellA And Range("B" & j).Value = cellB Then
        If Range("C" & j).Value = cellC And Range("D" & j).Value = cellD Then                  

            If cellE > Range("E" & j).Value Then
                Range("E" & j).EntireRow.Delete
                LastRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row

            End If

        End If
    End If
Next j
Next i
            LastRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
            With ActiveSheet
            Set Rng = Range("A1", Range("E1").End(xlDown))
            Rng.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5), Header:=xlYes
            End With

End Sub

Deleting Similar Rows using Excel VBA

1 Answers