Report Offensive Message

Ugh! Too much work. I prefer to let the computer do the work for me. I sort first then use custom macros:

Sub NextAlike()
' This macro moves the active cell down until it finds a duplicate.
a = 0
Do Until a = 1
Item = ActiveCell
ActiveCell.Offset(1, 0).Range("A1").Select
NextItem = ActiveCell
If NextItem = Item Then
ActiveCell.Offset(-1, 0).Range("A1").Select
a = 1
End If
Loop
End Sub

If I want to delete duplicates:

Sub DeleteDups()
' Deletes entire rows that have duplicate data in the current column.
' Safety Recommendation: Do not setup a toolbar button for this macro.
DialogStyle = vbYesNo + vbCritical + vbDefaultButton2
Title = "Deleting Duplicates"
Msg = "Are you sure you want to delete entire rows?"
deleteDupRows = MsgBox(Msg, DialogStyle, Title)

If ActiveCell.Value "" And deleteDupRows = vbYes Then
Do While ActiveCell.Value ""
noDups = ActiveCell.Value
ActiveCell.Offset(1, 0).Range("A1").Select
If ActiveCell.Value = noDups Then
DelStartRow = ActiveCell.Row
Do While ActiveCell.Value = noDups
ActiveCell.Offset(1, 0).Range("A1").Select
Loop
DelEndRow = ActiveCell.Row - 1
Range(Cells(DelStartRow, 1), Cells(DelEndRow, 1)).EntireRow.Delete
GoBack = (DelEndRow - DelStartRow + 1) * -1
ActiveCell.Offset(GoBack, 0).Range("A1").Select
End If
Loop
ElseIf deleteDupRows = vbYes Then
Message = "You must start from a cell containing data."
X = MsgBox(Message, vbOKOnly, "Empty Cell")
End If
End Sub