Clear Duplicates - but retain the entire row

hmltnangel

Active Member
Joined
Aug 25, 2010
Messages
290
Office Version
  1. 365
Platform
  1. Windows
Morning all,

I was looking for a way to clear the contents of duplicate cells, retaining the first instance of the data.

However Excel seems to be setup to delete the rows/cells rather than clear the contents. After searching, I found this nice little bit of code for VBA that seems to work. But it takes nearly fifteen minutes to work. Any suggestions for shortening the length of time to allow the code to work, or a better solution?

VBA Code:
Sub test()
Dim LR As Long, i As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
For i = LR To 1 Step -1
    If WorksheetFunction.CountIf(Columns("A"), Range("A" & i).Value) > 1 Then Range("A" & i).Delete shift:=xlShiftUp
Next i
End Sub
 

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.
UNTESTED - so test on a COPY of your work, first!

I wonder whether turning off screen updating will help.
I also wonder whether clearcontents would work, instead of deleting the cells:
VBA Code:
Sub test()
Dim LR As Long, i As Long

Application.ScreenUpdating = False
    LR = Range("A" & Rows.Count).End(xlUp).Row
    For i = LR To 1 Step -1
        If WorksheetFunction.CountIf(Columns("A"), Range("A" & i).Value) > 1 Then Range("A" & i).ClearContents
    Next i
Application.ScreenUpdating = True
End Sub
 
Upvote 0
The code you supplied does not do what you say
- it deletes the cells and shifts the contents below up

To clear the contents only ...
VBA Code:
Sub test()
    Dim LR As Long, i As Long, uRng As Range
    LR = Range("A" & Rows.Count).End(xlUp).Row
    Set uRng = Range("A" & LR + 1)
    For i = LR To 1 Step -1
        If WorksheetFunction.CountIf(Range("A1").Resize(i), Range("A" & i).Value) > 1 Then Set uRng = Union(uRng, Range("A" & i))
    Next i
    uRng.ClearContents
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,256
Members
448,558
Latest member
aivin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top