ExcelBanter - View Single Post - delete duplicates macro to color instead of delete

Tom Ogilvy

Public Sub DELETE_DUPLICATE_ROWS()
'
' This macro deletes duplicate rows in the selection. Duplicates are
' counted in the COLUMN of the active cell.

Dim col As Integer
Dim r As Long
Dim C As Range
Dim N As Long
Dim V As Variant
Dim rng As Range

On Error GoTo EndMacro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

col = ActiveCell.Column

If Selection.Rows.Count 1 Then
Set rng = Selection
Else
Set rng = ActiveSheet.UsedRange.Rows
End If

N = 0
For r = rng.Rows.Count To 1 Step -1
V = rng.Cells(r, 1).Value
If Application.WorksheetFunction.CountIf(rng.Columns( 1), V) 1 Then
rng.Rows(r).EntireRow.Interior.ColorIndex = 5
N = N + 1
End If
Next r

EndMacro:

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

--
Regards,
Tom Ogilvy

"DKY" wrote in message
...

I have this macro I found online. Once I sort my sheet by the column of
the selection that I'm' about to make (it has to be sorted) I then
select all the data in that column and this macro runs through and
deletes rows in which there are duplicate numbers. I'm trying to edit
it so that instead of deleting it colors it so I can decide what to do
from there. Here's the code.

Code:
--------------------
Public Sub DELETE_DUPLICATE_ROWS()
'
' This macro deletes duplicate rows in the selection. Duplicates are
' counted in the COLUMN of the active cell.

Dim col As Integer
Dim r As Long
Dim C As Range
Dim N As Long
Dim V As Variant
Dim rng As Range

On Error GoTo EndMacro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

col = ActiveCell.Column

If Selection.Rows.Count 1 Then
Set rng = Selection
Else
Set rng = ActiveSheet.UsedRange.Rows
End If

N = 0
For r = rng.Rows.Count To 1 Step -1
V = rng.Cells(r, 1).Value
If Application.WorksheetFunction.CountIf(rng.Columns( 1), V) 1 Then
rng.Rows(r).EntireRow.delete
N = N + 1
End If
Next r

EndMacro:

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

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

I try and replace the
rng.Rows(r).EntireRow.delete
with
rng.Rows(r).EntireRow.ColorIndex = 36
and the macro doesn't work right. It runs until it finds a duplicate
then it Ends the Macro. Does anyone know why my snippet of code is
stopping this from running correctly?

--
DKY
------------------------------------------------------------------------
DKY's Profile:
http://www.excelforum.com/member.php...o&userid=14515
View this thread: http://www.excelforum.com/showthread...hreadid=471112