Chip Pearson has quite a bit of information on duplicates. See
'Replacing Duplicate Entries' for an example of code.

You need to step backwards through the rows when deleting rows so that
you don't throw the count off as you delete rows.

http://www.cpearson.com/excel/duplicat.htm

Here's a routine that you can study and adapt, in addition to the info
provided by Chip. Watch for line wrap.

Sub RemoveDuplicatesGeneric()
'' Delete duplicate entries.

Dim rngAnswer As Range
Dim intCnt As Integer, intR As Integer, intI As Integer
Dim intRow As Integer, intCol As Integer

On Error Resume Next
Set rngAnswer = Application.InputBox _
("Please choose the first cell of the range to examine for
duplicates.", Type:=8)
If rngAnswer Is Nothing Then Exit Sub
If rngAnswer.Count < 1 Then Exit Sub
On Error GoTo 0

intRow = rngAnswer.End(xlDown).Row
intCol = rngAnswer.Column

Application.ScreenUpdating = False
intCnt = Application.WorksheetFunction.CountA(Range(rngAnsw er,
Cells(intRow, intCol)))

For intR = intRow To (intRow - intCnt + 2) Step -1
If Cells(intR, intCol).Value = Cells(intR, intCol).Offset(-1,
0).Value Then
Cells(intR, intCol).EntireRow.Delete
End If
Next intR

End Sub

Tested using Excel 97SR2 on Windows 98SE,

HTH
Paul
--------------------------------------------------------------------------------------------------------------
Be advised to back up your WorkBook before attempting to make changes.
--------------------------------------------------------------------------------------------------------------

I'm an Excel VBA newbie trying to delete rows from a spreadsheet based
upon duplicated values in a particular column (the sheet has been
sorted by the column of interest). I want the macro to compare the
value of the activecell with the value of the cell in next row (same
column). If the values are identical I want the entire row beneath
the current row to be deleted.

I suspect the code below is slow (if I could get it to run), but I'd
love to see what I'm doing wrong. Any help would be appreciated.
Thanks


LastRow = Selection.SpecialCells(xlLastCell).Row

For x = 1 To LastRow
If ActiveCell.Value = ActiveCell.Offset(1, 0).Value Then
ActiveCell.Offset(1, 0).EntireRow.Delete
End If
ActiveCell.Offset(1, 0).Select
Next x

Thanks
Phil Horwood