D'OH! well I missed that nugget of information, sorry :) But glad you like it
none the less...it's one of my favs, use it atleast twice daily!
Take Care!

"Matilda" wrote:

Hi Barbara,
That piece of code works with the speed of light! It's a little gem, and I
have many uses for it so will put it in my stash - thankyou. However my
present problem is that all the rows are different in one respect. I need to
ignore that column, and compare the rest - that is what is giving me the
headache.
Excelent's danish kode does the trick (and I have sped it up considerably,
thankyou!) so case solved plus bonus :-)))

Many thanks

Matilda

"Barbara" wrote:

Found this a few months back and works GREAT - lost it when I upgraded my
Office but found it again last night. Isn't very slow, actually 10 seconds or
so for 300 lines...much more bearable than trying to delete each duplicate
manually. good luck

Public Sub DeleteDuplicateRows()
'
' This macro deletes duplicate rows in the selection. Duplicates are
' counted in the COLUMN of the active cell.

Dim Col As Integer
Dim r As Long
Dim C As Range
Dim N As Long
Dim V As Variant
Dim Rng As Range

On Error GoTo EndMacro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Col = ActiveCell.Column

If Selection.Rows.Count 1 Then
Set Rng = Selection
Else
Set Rng = ActiveSheet.UsedRange.Rows
End If

N = 0
For r = Rng.Rows.Count To 1 Step -1
V = Rng.Cells(r, 1).Value
If Application.WorksheetFunction.CountIf(Rng.Columns( 1), V) 1 Then
Rng.Rows(r).EntireRow.Delete
N = N + 1
End If
Next r

EndMacro:

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

"Matilda" wrote:

ooo yeah !!

thanks, Excelent, it works really well! I ran it with the expected results,
so now I will step through and see if I can follow the logic.
It still takes 13 sec so will need to dynamically assign the range, but
looking good.

btw is that cherman or austrian accent I hear :-)

thankyou all,

Matilda

"excelent" wrote:

this kode put "Dublicate" in column 10 (J) if is a dublicate
and check in column 1,2 and 5-9
i hope i got ur right

Sub SletDubletter()

Dim r, t, t2, t3, rw, tValue()
t3 = Cells(65500, 1).End(xlUp).Row
ReDim tValue(t3)
For rw = 1 To Cells(65500, 1).End(xlUp).Row
tValue(rw) = Cells(rw, 1) & Cells(rw, 2) & _
Cells(rw, 5) & Cells(rw, 6) & Cells(rw, 7) & Cells(rw, 8) & Cells(rw, 9)
Next
For t = 1 To UBound(tValue)
If tValue(t) < "" Then
For t2 = t + 1 To UBound(tValue)
If tValue(t) = tValue(t2) Then
tValue(t2) = "Dublicate"
End If
Next
End If
Next
For t = 1 To UBound(tValue)
If tValue(t) = "Dublicate" Then Cells(t, 10) = tValue(t)
Next

End Sub