CODEWITHSUNDEEP
vbaexcel
Rafael Osipov
Rafael Osipov

Reputation: 740

Excel VBA Remove Triple Duplicate in One Row Loop

I want to delete entire row when all 3 numeric values in cells in columns G,H,I are equal. I wrote a vba code and it does not delete nothing. can Someone advise?

Sub remove_dup()

Dim rng As Range
Dim NumRows As Long
Dim i As Long


Set rng = Range("G2", Range("G2").End(xlDown))
NumRows = Range("G2", Range("G2").End(xlDown)).Rows.Count

For i = 2 To NumRows

Cells(i, 7).Select
If Cells(i, 7).Value = Cells(i, 8).Value = Cells(i, 9).Value Then
EntireRow.Delete
Else
Selection.Offset(1, 0).Select
End If

Next i

End Sub

Upvotes: 1

Views: 156

Answers (3)

Mrig
Mrig

Reputation: 11702

You can delete all rows together using UNION. Try this

Sub remove_dup()
    Dim ws As Worksheet
    Dim lastRow As Long, i As Long
    Dim cel As Range, rng As Range

    Set ws = ThisWorkbook.Sheets("Sheet4")  'change Sheet3 to your data range
    With ws
        lastRow = .Cells(.Rows.Count, "G").End(xlUp).Row    'last row with data in Column G
        For i = lastRow To 2 Step -1    'loop from bottom to top
            If .Range("G" & i).Value = .Range("H" & i).Value And .Range("G" & i).Value = .Range("I" & i).Value Then
                If rng Is Nothing Then          'put cell in a range
                    Set rng = .Range("G" & i)
                Else
                    Set rng = Union(rng, .Range("G" & i))
                End If
            End If
        Next i
    End With
    rng.EntireRow.Delete    'delete all rows together
End Sub

Upvotes: 1

Subodh Tiwari sktneer
Subodh Tiwari sktneer

Reputation: 9976

Remember when you delete rows, all you need to loop in reverse order.

Please give this a try...

Sub remove_dup()
Dim NumRows As Long
Dim i As Long

NumRows = Cells(Rows.Count, "G").End(xlUp).Row

For i = NumRows To 2 Step -1
    If Application.CountIf(Range(Cells(i, 7), Cells(i, 9)), Cells(i, 7)) = 3 Then
        Rows(i).Delete
    End If
Next i

End Sub

Upvotes: 1

Kresimir L.
Kresimir L.

Reputation: 2441

Try this code. When deleting rows, always start from last row and work towards first one. That way you are sure you wont skip any row.

Sub remove_dup()
Dim rng As Range
Dim NumRows As Long
Dim i As Long

NumRows = Range("G2", Range("G2").End(xlDown)).Rows.Count
For i = NumRows + 1 To 2 Step -1
        If Cells(i, 7).Value = Cells(i, 8).Value And Cells(i, 7).Value = Cells(i, 9).Value Then
                    Cells(i, 7).EntireRow.Delete
        Else
        End If
Next i
End Sub

Upvotes: 1

Related Questions