PDA

View Full Version : Solved: Delete Duplicate Rows based on multiple columns



feathers212
12-15-2006, 08:56 AM
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
12-15-2006, 09:07 AM
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
12-15-2006, 10:52 AM
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
12-15-2006, 11:27 AM
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
12-16-2006, 05:04 AM
Hi Bob,
It's amazing the uses you find for SUMPRODUCT. I'd never have thought of that! :bow:
Regards
Malcolm

Bob Phillips
12-16-2006, 05:49 AM
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:

feathers212
12-18-2006, 06:39 AM
The revision coding worked out perfectly. Thanks for your help!:thumb

Zack Barresse
12-18-2006, 09:56 AM
Why loop? ...

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

HTH

mvandhu
09-01-2011, 05:21 AM
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
09-01-2011, 05:27 AM
There is a new post button halfway down the page, on the left, with the VBAX logo and 'New Post'

mvandhu
09-01-2011, 05:33 AM
i am not able to find it. i can see only Quote and post reply:dunno

mvandhu
09-01-2011, 05:44 AM
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
09-01-2011, 02:06 PM
i am not able to find it. i can see only Quote and post reply:dunno


Hi XLD, need your help (http://www.vbaexpress.com/forum/showthread.php?t=38865)


:friends:

Bob Phillips
09-01-2011, 02:13 PM
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.

ArchanaR1111
08-14-2021, 09:19 AM
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)