Macro Delete Duplicate Rows with Exception

I am creating a macro to delete rows based on a duplicate value in column E (see code below). However, there are times that I signify a blank cell with "--", in these instances I would like to not delete those rows because there is other information that is needed. Thanks for your help in advance.

Private Sub RemoveDuplicateRowsSR()

Dim rCell As Range
    Dim rRange As Range
    Dim lCount As Long
     
    Set rRange = Range("E8", Range("E" & Rows.Count).End(xlUp))
    lCount = rRange.Rows.Count
     
    For lCount = lCount To 1 Step -1
        With rRange.Cells(lCount, 1)
            If WorksheetFunction.CountIf(rRange, .Value) > 1 Then
                .EntireRow.Delete
            End If
        End With
    Next lCount

End Sub

Do you have a sample file that you can upload?

Using AdvancedFilter is a good way to remove duplicates for xl2003; however your added condition of keeping all "--" rows, makes that more difficult. To do this with AdvancedFilter, you would probably need to have two filter-copy steps or use a formula-based criteria instead with Unique=False.

Here is some code you could try that uses a temporary column of formulas to mark those to be deleted.

Sub Delete_Dups_with_Exception()
    Dim lCol As Long, lRow As Long, i As Long
    
    lCol = Cells.Find(What:="*", _
            After:=Cells(1, Cells.Columns.Count), _
            SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    lRow = Range("E" & Rows.Count).End(xlUp).Row
    If lRow < 8 Then Exit Sub
    
    On Error GoTo CleanUp
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
        
    With Range("E8:E" & lRow)
        '---Fill temp column with fomulas to mark rows to delete
        With Cells(.Row, lCol + 1).Resize(.Rows.Count)
            .FormulaR1C1 = "=IF(OR(RC5=""--"",MATCH(RC5,C5,0)=ROW(RC)),""Keep"","""")"
            .Value = .Value
            .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        End With
    End With
CleanUp:
    If lCol > 0 Then Columns(lCol + 1).ClearContents
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

This just looks for duplicates in Column E. You could repeat the process for Column K, or try to modify the formula to do it in one pass.

The error message is because the range that was copied is no longer available to be pasted through VBA after executing the ActiveSheet.ShowAllData statement.

One workaround is to paste the Unique Values to a temporary location.

Here's some code that temporarily pastes the values below the data

Sub RemoveDuplicateRows()
    Dim lRow As Long
     
    
    lRow = Cells.Find(What:="*", After:=Range("A1"), _
        SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

    If lRow < 9 Then Exit Sub
    Application.ScreenUpdating = False
    With Range("B7:N" & lRow)  'Row 7 has headers
        .AdvancedFilter Action:=xlFilterInPlace, Unique:=True
        If .Parent.FilterMode Then
            .SpecialCells(xlCellTypeVisible).Copy
            .Offset(lRow).PasteSpecial (xlPasteValues)
            .Parent.ShowAllData
            .ClearContents
            .Offset(lRow).Resize(lRow).Copy
            .Cells(1).PasteSpecial (xlPasteValues)
            .Offset(lRow).Resize(lRow).ClearContents
        End If
    End With
    
    Application.ScreenUpdating = True
End Sub