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