Billy

the following code based on an example in the JWalk website will
delete the rows containing duplicates leaving one original entry. It
assumes you have selected the range you wish to deduplicate

Sub Uniques_Delete_Row()
Dim AllCells, Cell, DelRange As Range
Dim i, j, k As Integer
Dim NoDupes As New Collection

'break key calls errorhandler
On Error GoTo ErrorHandler
Application.EnableCancelKey = xlErrorHandler
'check we are in worksheet
If TypeName(ActiveSheet) < "Worksheet" Then
MsgBox "This macro only works on a worksheet"
Exit Sub
End If

'downsize selection to be within used range
Set AllCells = Intersect(ActiveSheet.UsedRange, Selection)

'The next statement ignores the error caused
'by attempting to add a duplicate key to the collection.
'The duplicate is not added - which is just what we want!
For Each Cell In AllCells
On Error GoTo ErrorDuplicate
If Cell.Value < vbNullString Then
NoDupes.Add LCase(Cell.Value), CStr(Cell.Value)
' Note: the 2nd argument (key) for the Add method must
be a string
End If
Next Cell

If DelRange Is Nothing Then
Exit Sub
Else
DelRange.EntireRow.Delete
End If

Exit Sub
ErrorDuplicate:
'collect the cells to be deleted
If DelRange Is Nothing Then
Set DelRange = Cell
Else
Set DelRange = Union(DelRange, Cell)
End If

Resume Next

ErrorHandler:
Beep
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
Application.StatusBar = False
Response = MsgBox("Macro unexpectedly terminated because" &
Chr(13) & Error(Err), vbCritical, "Macro terminated")
Exit Sub

End Sub

hth

Mike B