Solved: Delete duplicated rows

[CicoMico]

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]

Here is an example that you can try. It is from this forum....although I don't remember who submitted it It is not mine, so I won't take credit it for it. Hopefully you can use/modify to fit your needs.

[VBA] 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[/VBA]

[VBA] 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
[/VBA]

[VBA] Sub MarkDups(Rng As Range)

Dim cel As Range, c As Range
Dim firstaddress AsString

For Each cel In Rng
If cel.Interior.ColorIndex <> 6 Then
With Rng
Set c = .Find(cel, LookIn:=xlValues, After:=Range("A1"))
IfNot c IsNothingThen
firstaddress = c.Address
Do
If c.Address <> firstaddress Then
c.Interior.ColorIndex = 6
EndIf
Set c = .FindNext(c)
LoopWhileNot c IsNothingAnd c.Address <> firstaddress
EndIf
End With
EndIf
Next


End Sub
[/VBA]

[CicoMico]

thanx. but i can't use sorting method... i can't sort my data (Order1:=xlAscending), because it's in logical sections...

[Bob Phillips]

How many columns need to be checked for identical-ness?

Can you post a workbook.

[CodeMakr]

Just use the "MarkDups" sub and not the other 2 (which will leave out the sort).

[CicoMico]

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]

[vba]


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
[/vba]

[CicoMico]

[vba]


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
[/vba]

PERFECT!!!!! THANK YOU!!!!!