Solved: Delete Duplicate Rows based on multiple columns

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

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

Code:

---


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

---

Quote:

---

Originally Posted by xld

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.

Revision

Code:

---

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

---

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

Quote:

---

Originally Posted by mdmackillop

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

---

I can't get it out of my head :bug:

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

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

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

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

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

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.

Quote:

---

Originally Posted by mvandhu

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

---

Hi XLD, need your help


:friends:

Quote:

---

Originally Posted by mvandhu

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

---

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

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)