Snasui Excel Forum

Code: Select all

Sub Deleterow()
    Dim r As Range
    Dim rAll As Range
    With Sheets("Sheet1")
        Set rAll = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
    End With
    For Each r In rAll
        With Application
            If .CountIf(rAll, r) <> .CountIfs(rAll, r, rAll.Offset(0, 2), "manual") Then
                r.ClearContents
            End If
        End With
    Next r
    rAll.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

Code: Select all

With Application
            If .CountIf(rAll, r) <> .CountIfs(rAll, r, rAll.Offset(0, 2), "manual") Then
                r.ClearContents
            End If
        End With