This is a lot trickier than I thought at first.

In column A, text or values not a result of formulas:

aaa
bbb
ccc
xxx
a12
b12
c12
yyy
aaa
bbb
ccc
a12
zzz
b12
c12

Delete entire row of the duplicated entries.

After code has run on column A:

xxx
yyy
zzz

Produces a list (keeps the associated row) of single entry items only, others and their row are deleted.

Thanks,
Howard

hi Howard,

Am Sun, 10 May 2015 03:54:55 -0700 (PDT) schrieb L. Howard:

aaa
bbb
ccc
xxx
a12
b12
c12
yyy
aaa
bbb
ccc
a12
zzz
b12
c12

Delete entire row of the duplicated entries.

After code has run on column A:

xxx
yyy
zzz

try:

Sub Test()
Dim LRow As Long, i As Long, n As Long
Dim varOut() As Variant

Application.ScreenUpdating = False
With ActiveSheet
LRow = .Cells(Rows.Count, 1).End(xlUp).Row
ReDim Preserve varOut(LRow - 1, 1)
For i = 1 To LRow
With Application
varOut(n, 0) = .Cells(i, 1).Value
varOut(n, 1) = .CountIf(.Range("A1:A" & LRow), .Cells(i, 1))
n = n + 1
End With
Next
For i = UBound(varOut) To LBound(varOut) Step -1
If varOut(i, 1) 1 Then
.Rows(i + 1).Delete
End If
Next
End With
Application.ScreenUpdating = True
End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

try:

Sub Test()
Dim LRow As Long, i As Long, n As Long
Dim varOut() As Variant

Application.ScreenUpdating = False
With ActiveSheet
LRow = .Cells(Rows.Count, 1).End(xlUp).Row
ReDim Preserve varOut(LRow - 1, 1)
For i = 1 To LRow
With Application
varOut(n, 0) = .Cells(i, 1).Value
varOut(n, 1) = .CountIf(.Range("A1:A" & LRow), .Cells(i, 1))
n = n + 1
End With
Next
For i = UBound(varOut) To LBound(varOut) Step -1
If varOut(i, 1) 1 Then
.Rows(i + 1).Delete
End If
Next
End With
Application.ScreenUpdating = True
End Sub


Regards
Claus B.

Great stuff, nice as can be.

Thanks Claus.

Howard