This seems to work:


Code:
--------------------
Sub DeleteDupRow()
'
'
'Deletes row if there is
'a duplicate found in the
'column
'
Dim currentcell As Range
Dim nextcell As Range

Application.ScreenUpdating = False

Sheets.Add 'Adds new worksheet to the left
ActiveSheet.Name = "Duplicates" 'renames new worksheet
ActiveSheet.Next.Select 'moves one worksheet to the right

Set currentcell = ActiveCell

Do While Not IsEmpty(currentcell.Offset(0, 0))
Set nextcell = currentcell.Offset(1, 0)

If nextcell.Value = currentcell.Value Then
currentcell.EntireRow.Copy (Worksheets("Duplicates").Range("A65536").End(xlUp ).Offset(1, 0))
End If

If nextcell.Value = currentcell.Value Then
currentcell.EntireRow.Delete
End If

Set currentcell = nextcell
Loop

Set currentcell = Nothing
Application.ScreenUpdating = True

End Sub
--------------------


Is there any better way of doing this do you think?


--
Daminc
------------------------------------------------------------------------
Daminc's Profile: http://www.excelforum.com/member.php...o&userid=27074
View this thread: http://www.excelforum.com/showthread...hreadid=519277