Delete Duplicate Rows, if column does not contain x

**JulieQ** · 11-13-2015, 09:44 PM

Hello!

I have an excel VB script/Macro that deletes duplicate rows, but I now need to expand it and I can't figure out how (& I’m limited for time):

What I want to do is: Compare columns A, B for duplicate rows, and if duplicate row exists, ONLY delete if column D does not say “Closed” or “Abandoned”.

Any suggestions on how to search sheet for duplicates rows based on column A B, and only delete row if column D of the duplicate row does not say “Closed” or “Abandoned”?

(At any given time, there is 100 to 3000 rows of data; thus, do not want to use filters or conditional formatting, or anything manual to visually search for duplicates and delete).

Example data:
123 John Apple Open ** This row would be deleted
124 Mary Apple Closed
125 Sara Apple Open
123 John Apple Closed
123 John Apple Pending ** This row would be deleted

Example delete duplicate VB/Macro I had previously used:
'delete duplicates rows
destSheet.UsedRange.RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes

Thank-you,
Julie!

**Trebor76** · 11-13-2015, 11:09 PM

Hi Julie,

Try this macro (though initially on a copy of your data as the results cannot be undone if they're not as expected) while on the sheet with the data:

Option Explicit
Sub Macro1()

    Dim lngLastRow As Long
    Dim lngLastCol As Long
    Dim lngMyRow As Long
    Dim lngMyCol As Long
    Dim strMyCol As String
    
    Application.ScreenUpdating = False
    
    lngLastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    lngLastCol = Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    
    With Range(Cells(2, lngLastCol + 1), Cells(lngLastRow, lngLastCol + 1))
        .Formula = "=IF(AND(TRIM(D2)<>""Closed"",TRIM(D2)<>""Abandoned""),A2&B2,"""")"
        .Value = .Value
    End With
        
    strMyCol = Left(Cells(1, lngLastCol + 1).Address(True, False), Application.WorksheetFunction.Search("$", Cells(1, lngLastCol + 1).Address(True, False)) - 1)
        
    With Range(Cells(2, lngLastCol + 2), Cells(lngLastRow, lngLastCol + 2))
        .Formula = "=IF(" & strMyCol & "2<>"""",COUNTIF($" & strMyCol & "$2:$" & strMyCol & "$" & lngLastRow & "," & strMyCol & "2),"""")"
        .Value = .Value
    End With
        
    For lngMyRow = lngLastRow To 2 Step -1
        If Val(Cells(lngMyRow, lngLastCol + 2)) > 1 Then
            Rows(lngMyRow).EntireRow.Delete
        End If
    Next lngMyRow
    
    For lngMyCol = lngLastCol + 2 To lngLastCol + 1 Step -1
        Columns(lngMyCol).EntireColumn.Delete
    Next lngMyCol
    
    Application.ScreenUpdating = True
    
    MsgBox "Done"

End Sub

Regards,

Robert

**Philb1** · 11-14-2015, 07:16 AM

Hi Julie
Here's another routine that I think does what you want. I've assumed it's sheet 1 & the top row of the data is row 5, change the numbers to suit.
It sorts the data into ascending order by column A & then column B,it doesn't delete any columns, only duplicate rows that don't contain Closed or Abandoned in column D.
As Trebor says, test it on a copy
Cheers

Option Explicit

Sub DeleteRows()

Dim Ws1 As Worksheet
Dim DataTopRow As Long, i As Long, n As Long
Dim rData As Range
Dim Cls As String
Dim Abnd As String

Set Ws1 = ThisWorkbook.Sheets(1) ' Assuming Sheet 1

DataTopRow = 5 ' Change to suit the top row of data on your sheet
Cls = "CLOSED"
Abnd = "ABANDONED"


    Set rData = Ws1.Range(Ws1.Cells(DataTopRow, 1), Ws1.Cells(Rows.Count, 4).End(xlUp))

    With rData ' Sort Data Into Ascending Order
        rData.Sort Key1:=Ws1.Cells(DataTopRow, 1), Order1:=xlAscending, _
                                    Key2:=Ws1.Cells(DataTopRow, 2), Order2:=xlAscending, _
                                    Header:=xlGuess, MatchCase:=False, Orientation:=xlTopToBottom, _
                                    DataOption1:=xlSortNormal
    End With
    
    n = Application.WorksheetFunction.Count(Ws1.Range(Ws1.Cells(DataTopRow, 1), _
            Ws1.Cells(Rows.Count, 1).End(xlUp))) + DataTopRow - 1

    For i = DataTopRow To n
    
        If Ws1.Cells(i, 1) = Ws1.Cells(i + 1, 1) And _
            Ws1.Cells(i, 2) = Ws1.Cells(i + 1, 2) Then
            If Not InStr(1, UCase(Ws1.Cells(i, 4)), Cls, vbTextCompare) > 0 Or _
                InStr(1, UCase(Ws1.Cells(i, 4)), Abnd, vbTextCompare) > 0 Then
                
                Ws1.Cells(i, 1).EntireRow.Delete
                
                i = i - 1
                
                n = Application.WorksheetFunction.Count(Ws1.Range(Ws1.Cells(DataTopRow, 1), _
                        Ws1.Cells(Rows.Count, 1).End(xlUp))) + DataTopRow - 1
        
            ElseIf Not InStr(1, UCase(Ws1.Cells(i + 1, 4)), Cls, vbTextCompare) > 0 Or _
                    InStr(1, UCase(Ws1.Cells(i + 1, 4)), Abnd, vbTextCompare) > 0 Then
                    
                Ws1.Cells(i + 1, 1).EntireRow.Delete
                
                i = i - 1
                
                n = Application.WorksheetFunction.Count(Ws1.Range(Ws1.Cells(DataTopRow, 1), _
                        Ws1.Cells(Rows.Count, 1).End(xlUp))) + DataTopRow - 1
        
            End If
        End If
            
        If i = n Then Exit For
    
    Next i

    MsgBox "Done" ' Delete me if you done want the messagebox
    
Exit Sub

End Sub