This is exactly what I need. I'm new to Excel Macros. How do I add this
subroutine function to an existing Macro? Thanks.



"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