Newbie question on deleting duplicate rows

[Phil Horwood]

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

 

[pfsardella]

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(rngAnswer,
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

 

[D.S.]

Could try this, if you believe all your duplicates will always be in adjacent rows.

Range("A1").select 'or where ever you wish to start
do until activecell.value="" 'stops at empty cell
if activecell.value=activecell.offset(1,0).value then
activecell.offset(1,0).entirerow.delete
else
activecell.offset(1,0).select
end if
loop
range("A1").select 'go back to starting cell, or the cell of your choice


I'm running Excel 2002 SP-2

D.S.
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(rngAnswer,
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

 

[Phil Horwood]

Thanks Paul.

 

[Phil Horwood]

Thanks Don - I went with your solution and it worked. Since the macro
sorts the spreadsheet prior to deleting rows, all my duplicates are in
adjacent rows.

Regards
Phil Horwood