Clear Duplicates - but retain the entire row

hmltnangel

Board Regular
Joined
Aug 25, 2010
Messages
201
Office Version
  1. 2016
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
 

Some videos you may like

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.

sykes

Well-known Member
Joined
May 1, 2002
Messages
1,773
Office Version
  1. 365
Platform
  1. Windows
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
 

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
6,975
Office Version
  1. 365
Platform
  1. Windows
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
 

Watch MrExcel Video

Forum statistics

Threads
1,122,233
Messages
5,594,963
Members
413,954
Latest member
mrsandy

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
Top