finding duplicate cell and deleting both

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

I'd add a helper column to do this. Let's say your data is in B2:B1000. In
your helper column, put this

=countif(B$2:B$1000,B2)

And copy to the end.
I'd then use autofilter to find all values of the helper column that are
greater than 1.
 
Sort the data and then run this macro:

Sub CheckForDupes()
Dim RowNdx As Long
Dim ColNum As Integer
ColNum = Selection(1).Column 'set number to match the proper column
For RowNdx = Selection(Selection.Cells.Count).Row To _
Selection(1).Row + 1 Step -1
If Cells(RowNdx, ColNum).Value = Cells(RowNdx - 1, ColNum).Value Then
Cells(RowNdx, ColNum).Delete shift:=xlUp
End If
Next RowNdx
End Sub


Warning!! Use this macro on a sample of your data; test it on a small
sample. If it doesn't do what you want post back. It is extremely
frustrating to accidentally delete data that you didn't really want to delete.


Hope that helps,
Ryan---
 
Hi;

I have about 8000 cells of which 800 are duplicates. I want to find all the
dupes and delete BOTH copies of them. Can that be done and if so, how ?


Thanks;

Pat
 
Thanks Barb;
This is a good start. These cells each contain an email address and they're
arranged in one column. The results (2's) point to dupes in the 2 cells
below, but the auto sort doesn't isolate them. Is there a way bring all the
dupes together for a quick delete ?

Pat
 
Thanks;

That got rid of one each of the dupes, but I need to get rid of both copies
of each dupe. Can this macro be amended to do that ?


Pat
 
Have your data in Column A
Have unique values in Column B
Data > Filter > Advanced Filter > Unique Records Only
Put this function in C1:
=COUNTIF($A$1000:$A$1000,$B$1000:$B$1000)
Fill down to end of list.

Run this sub:
Sub Delete_with_Autofilter()
Dim DeleteValue As String
Dim rng As Range

DeleteValue = "1"
With ActiveSheet
.Range("C1:C1000").AutoFilter Field:=1, Criteria1:="<>1"
With ActiveSheet.AutoFilter.Range
On Error Resume Next
Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rng Is Nothing Then rng.EntireRow.Delete

End With
.AutoFilterMode = False
End With
End Sub

Hope that helps,
Ryan---
 
Back
Top