Solved: Delete Duplicate Rows based on multiple columns

[feathers212]

I am working with Excel 2003, but need code that will also work with Excel 2000 run by other users.

I have a worksheet with columns A-P. I want to delete rows that have duplicate data in columns A, B, and C. It does not matter what data is in the other columns.

For example:
A, B, C, D
1, X, 52, purple
1, X, 52, yellow
1, X, 17, blue
2, X, 52, purple
2, X, 52, purple
2, X, 17, blue
2, Z, 52, red

Once I run the code, I want the following rows to remain:
A, B, C, D
1, X, 52, purple
1, X, 17, blue
2, X, 52, purple
2, X, 17, blue
2, Z, 52, red


Basically, I want to delete duplicate records based on multiple columns.

Thanks!
~Heather

[Bob Phillips]

Row 2 is not a duplicate, so doesn't get deleted

Public Sub ProcessData()
Const TEST_COLUMN As String = "A"    '<=== change to suit
Dim i As Long
Dim iLastRow As Long
Dim rng As Range

    With ActiveSheet
        
        iLastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
        For i = iLastRow To 2 Step -1
            If .Evaluate("SUMPRODUCT(--(A" & i & ":A" & iLastRow & "=A" & i & ")," & _
                                    "--(B" & i & ":B" & iLastRow & "=B" & i & ")," & _
                                    "--(C" & i & ":C" & iLastRow & "=C" & i & "))") > 1 Then
                If rng Is Nothing Then
                    Set rng = .Rows(i)
                Else
                    Set rng = Union(rng, .Rows(i))
                End If
            End If
        Next i
        
        If Not rng Is Nothing Then rng.Delete
        
    End With
    
End Sub

[feathers212]

Row 2 is not a duplicate, so doesn't get deleted

I am not looking for the entire row to be a duplicate. Only the values in columns A, B, and C for each row need to be the same for the row to be deleted. So in the way that I am defining "duplicate", row 2 is a repeat of row 1 and can be deleted. The information in column D is not important.

[Bob Phillips]

Revision

Public Sub ProcessData()
    Const TEST_COLUMN As String = "A" '<=== change to suit
    Dim i As Long
    Dim iLastRow As Long
    Dim rng As Range
     
    With ActiveSheet
         
        iLastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
        For i = 1 To iLastRow
            If .Evaluate("SUMPRODUCT(--(A" & i & ":A" & iLastRow & "=A" & i & ")," & _
            "--(B" & i & ":B" & iLastRow & "=B" & i & ")," & _
            "--(C" & i & ":C" & iLastRow & "=C" & i & "))") > 1 Then
                If rng Is Nothing Then
                    Set rng = .Cells(i, "A").Resize(, 3)
                Else
                    Set rng = Union(rng, .Cells(i, "A").Resize(, 3))
                End If
            End If
        Next i
         
        If Not rng Is Nothing Then rng.Delete
         
    End With
     
End Sub

[mdmackillop]

Hi Bob,
It's amazing the uses you find for SUMPRODUCT. I'd never have thought of that!
Regards
Malcolm

[Bob Phillips]

Hi Bob,
It's amazing the uses you find for SUMPRODUCT. I'd never have thought of that!

I can't get it out of my head

[feathers212]

The revision coding worked out perfectly. Thanks for your help!

[Zack Barresse]

Why loop? ...

[vba]Sub ProcessData2()
Dim rngFormula As Range
With ActiveSheet
.Columns(1).Insert: .Columns(1).Insert
Set rngFormula = .Range("A2:A" & .Cells(.Rows.Count, "C").End(xlUp).Row)
rngFormula.Formula = "=C2&D2&E2"
rngFormula.Offset(0, 1).Formula = "=COUNTIF($A$2:A2,A2)"
.Cells.AutoFilter field:=2, Criteria1:="=2"
rngFormula.SpecialCells(xlCellTypeVisible).EntireRow.Delete
.Columns(1).Delete: .Columns(1).Delete
.AutoFilterMode = False
End With
End Sub[/vba]

HTH

[mvandhu]

can anyone tell me how to post a 'new post' in in this forum. I need help on a code. bot am not able to find where to post it

[Bob Phillips]

There is a new post button halfway down the page, on the left, with the VBAX logo and 'New Post'

[mvandhu]

i am not able to find it. i can see only Quote and post reply

[mvandhu]

ok..am posting it here itself..Need VBA code for the below mentioned scenario.
scenario:

I have 3 columns ID1, ID2, Name in sheet1 of my excel workbook.
Based on ID1 and ID2, my duplicate rows should be removed ie. the unique rows should be copied to my sheet2.

For Example

Sheet1:

ID1 ID2 Name
1 a Jack
2 b Rose
1 a Emily
1 b Jill
2 b Jeni
So in the example above I want to retain my 1st duplicate row in my sheet 2.
ie in sheet 2 my result should be as

ID1 ID2 Name
1 a Jack
2 b Rose
1 b Jill

The rows count always varies in my sheet 1.
Please help me out in this.
Since am new to this Macros it will be better if you could put comment lines for each and every step of code on what the code is doing.

[visible2you]

i am not able to find it. i can see only Quote and post reply

Hi XLD, need your help

[Bob Phillips]

i am not able to find it. i can see only Quote and post reply

It's in the forum, nit within a single thread.

[ArchanaR1111]

Hi Bob,

This works only on three columns.. is there any way to delete duplicates across multiple columns (i have a set of 28 columns in my excel)