Hello,

I have the below macro which deletes duplicate entries based on column "A"
part number. The worksheet has nine columns, and column nine includes the
UPC code. So some duplicate rows may contain column nine with a upc code and
some may be blank. I need the duplicate rows that contains the ups code not
to be deleted. Also, some duplicate rows may not contain any info in column
nine, so still need it to leave one and delete others.

Thanks JR


Public Sub DeleteDuplicateRows()
'
' 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

Try this: Change

Rng.Rows(r).EntireRow.Delete

to

If Rng.Cells(r, 9).Value = "" Then Rng.Rows(r).EntireRow.Delete

HTH,
Bernie
MS Excel MVP


"JR" <(E-Mail Removed)> wrote in message news:(E-Mail Removed)...
> Hello,
>
> I have the below macro which deletes duplicate entries based on column "A" part number. The
> worksheet has nine columns, and column nine includes the UPC code. So some duplicate rows may
> contain column nine with a upc code and some may be blank. I need the duplicate rows that contains
> the ups code not to be deleted. Also, some duplicate rows may not contain any info in column nine,
> so still need it to leave one and delete others.
>
> Thanks JR
>
>
> Public Sub DeleteDuplicateRows()
> '
> ' 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
>
>
>
>