PDA

View Full Version : [SOLVED] Identify unique items in column and delete row



blackie42
03-05-2017, 10:59 AM
Hi,

Anyone suggest a macro to identify where there is a unique entry in column A and then delete the whole row?

many thanks
Jon

Paul_Hossler
03-05-2017, 11:23 AM
Try this




Option Explicit

Sub Macro1()
Dim rFilter As Range, rVisible As Range
Dim iRow As Long, iArea As Long

Set rFilter = ActiveSheet.Range("A1")
Set rFilter = Range(rFilter, rFilter.End(xlDown))

rFilter.AdvancedFilter Action:=xlFilterInPlace, Unique:=True

Set rVisible = ActiveSheet.Columns(1).SpecialCells(xlCellTypeVisible)
Set rVisible = Intersect(rVisible, ActiveSheet.UsedRange)

ActiveSheet.ShowAllData

For iArea = rVisible.Areas.Count To 1 Step -1
For iRow = rVisible.Areas(iArea).Rows.Count To 1 Step -1
If Application.WorksheetFunction.CountIf(rFilter, rVisible.Areas(iArea).Cells(iRow, 1).Value) = 1 Then
If rVisible.Areas(iArea).Cells(iRow, 1).Row <> 1 Then
rVisible.Areas(iArea).Cells(iRow, 1).EntireRow.Delete
End If

End If
Next iRow
Next iArea

End Sub

blackie42
03-06-2017, 02:49 AM
Cheers Paul

Works perfectly

regards
Jon