Delete duplicates and more!
I'm not sure this will work in your case, but try this.
presuming data start from A1, and it will take some time if data many.
Sub deltest()
Dim start As Long, comp As Long
Dim endcell As Range
Application.ScreenUpdating = False
start = 1
comp = start + 1
Set endcell = Cells(Cells.Rows.Count, "a").End(xlUp).Offset(1, 0)
Do
If Cells(start, "a") < Cells(comp, "a") Then
If start < (comp - 1) Then
Rows(start + 1 & ":" & comp - 1).Delete
comp = start + 1
End If
start = comp
End If
comp = comp + 1
Loop Until (comp endcell.Row)
start = 1
comp = start + 1
Set endcell = Cells(Cells.Rows.Count, "a").End(xlUp).Offset(1, 0)
Do
If Cells(start, "a") & "-0" = Cells(comp, "a") Then
Rows(start).Delete
Else
start = start + 1
comp = start + 1
End If
Loop Until (comp endcell.Row)
End Sub
keizi
"Ramses" wrote in message
oups.com...
I'm trying to delete duplicates lines. I have a list with 40.000
items
And the list looks some like this:
A42U002-49 (x)
A42U002-49-0
A42U002-50 (x)
A42U002-50-0
A42U002-50-0 (x)
A42U002-50-01
A42U002-51
All lines ending with -0 is the same as line without but not line with
-1.
So I have to delete all the line mark with (x)
Anyone have an Idea how to do this ?
|