PDA

View Full Version : Solved: Delete duplicated rows



CicoMico
07-23-2007, 02:26 PM
Hello!

I want to check entire sheet and compare every row to find identical rows and then delete one of them. Any advice? Please!

CodeMakr
07-23-2007, 03:58 PM
Here is an example that you can try. It is from this forum....although I don't remember who submitted it :dunno It is not mine, so I won't take credit it for it. Hopefully you can use/modify to fit your needs.

Sub SortAndMark()

Dim Rng As Range

Set Rng = Sheets(1).Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp))

DoSort Rng
MarkDups Rng


End Sub

Sub DoSort(Rng As Range)

Rng.Resize(, 3).Select

Rng.Resize(, 3).Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _

OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom


End Sub


Sub MarkDups(Rng As Range)

Dim cel As Range, c As Range
Dim firstaddress As String

For Each cel In Rng
If cel.Interior.ColorIndex <> 6 Then
With Rng
Set c = .Find(cel, LookIn:=xlValues, After:=Range("A1"))
If Not c Is Nothing Then
firstaddress = c.Address
Do
If c.Address <> firstaddress Then
c.Interior.ColorIndex = 6
End If
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstaddress
End If
End With
End If
Next


End Sub

CicoMico
07-23-2007, 04:16 PM
thanx. but i can't use sorting method... i can't sort my data (Order1:=xlAscending), because it's in logical sections...

Bob Phillips
07-23-2007, 04:42 PM
How many columns need to be checked for identical-ness?

Can you post a workbook.

CodeMakr
07-23-2007, 04:59 PM
Just use the "MarkDups" sub and not the other 2 (which will leave out the sort).

CicoMico
07-24-2007, 01:13 AM
How many columns need to be checked for identical-ness?

Can you post a workbook.

i need to check only 1 column.

no i can't post wbk. it is internal project :(

Bob Phillips
07-24-2007, 02:18 AM
Public Sub ProcessData()
Const TEST_COLUMN As String = "A" '<=== change to suit
Const TEST_COL As Long = 1 '<=== and this to match
Dim i As Long
Dim iLastRow As Long

With ActiveSheet

iLastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = iLastRow To 1 Step -1
If Application.CountIf(.Columns(TEST_COL), .Cells(i, TEST_COLUMN).Value) > 1 Then
.Rows(i).Delete
End If
Next i

End With

End Sub

CicoMico
07-24-2007, 03:08 AM
Public Sub ProcessData()
Const TEST_COLUMN As String = "A" '<=== change to suit
Const TEST_COL As Long = 1 '<=== and this to match
Dim i As Long
Dim iLastRow As Long

With ActiveSheet

iLastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = iLastRow To 1 Step -1
If Application.CountIf(.Columns(TEST_COL), .Cells(i, TEST_COLUMN).Value) > 1 Then
.Rows(i).Delete
End If
Next i

End With

End Sub


PERFECT!!!!! THANK YOU!!!!! :clap::rotlaugh::bow::bow: