Delete the rows of the duplicates in a column, keep single entries only
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
|