Deleting duplicate Rows AND the original

[andycharger]

Hi,

Im my macro that I have, Im reusing some code I was referred to.
The code is below.

Code
-------------------

Range(Range("M2"), ActiveCell.SpecialCells(xlLastCell)).Select

Dim Col As Integer

Dim N As Long
Dim V As Variant

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Col = ActiveCell.Column

If Selection.Rows.Count > 1 Then
Set Rng = Selection
Else
Set Rng = ActiveSheet.UsedRange.Rows
End If

N = 0
For R = Rng.Rows.Count To 1 Step -1
V = Rng.Cells(R, 1).Value
If Application.WorksheetFunction.CountIf(Rng.Columns(1), V) > 1 Then
Rng.Rows(R).EntireRow.Delete
N = N + 1
End If
Next R

-------------------


However, what I need to do is delete ALL lines that match when
duplicate is found, not just the duplicates.

Example, if I have 3 rows that match, I need to delete all 3. If I onl
have 1 row and it is unique, dont do anything.

What my example does is find 3 duplicates and deletes 2 of them an
leaves 1 of the duplicate rows! Not good enough!!!

Any help is appreciated

 

[Bernie Deitrick]

Andy,

Below is code and an example of how to use it, do delete rows based on
duplicates in a specific column, in this case, column M.

Run the macro"ClearDupesM"

HTH,
Bernie
MS Excel MVP

Sub ClearDupesM()
DeleteDuplicates "M"
End Sub

Sub DeleteDuplicates(ColLet As String)
Dim myRows As Long
Dim ColNum As Integer
ColNum = Range(ColLet & "1").Column

Range("A1").EntireColumn.Insert
Range("A1").FormulaR1C1 = _
"=IF(COUNTIF(C[" & ColNum & "],RC[" & ColNum & "])>1, " & _
"""Trash"",""Keep"")"
myRows = ActiveSheet.UsedRange.Rows.Count
Range("A1").Copy Range("A1:A" & myRows)
With Range(Range("A1"), Range("A1").End(xlDown))
.Copy
.PasteSpecial Paste:=xlValues
End With
Cells.Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending
Dim myCell As Range
Set myCell = Columns("A:A").Find(What:="Trash", After:=Range("A1"))
If Not myCell Is Nothing Then
Range(myCell, myCell.End(xlDown)).EntireRow.Delete
End If
Range("A1").EntireColumn.Delete
End Sub

 

[andycharger]

Hi Bernie,

I tried your code but it puts "KEEP" in all my rows! however, there ar
definitely duplicates so most should say trash.

Any ideas what could be wrong

 

[andycharger]

I think its cos it is copying the contents of that cell (i.e. KEEP
rather than the formula. I need to replicate that formula all the wa
down. Something is not right with it anyhow! HELP!!!

 

[Bernie Deitrick]

Andy,

The code works, but doesn't check for all error conditions: it's a utility
that I use, but it's only for me, so I don't need to make sure that I'm
using it correctly. A few things I can think of is that column A is
formatted for text, and the formulas aren't entered properly, or you have
calculations set for manual, so you aren't actually calculating the values
for each cell.

Also, are you sure that you are passing it the correct column? Have you
tried stepping through the code: place your cursor in "ClearDupesM" and
press F8, which will execute one step at a time. Switch back out to your
worksheet after the the line:

Range("A1").Copy Range("A1:A" & myRows)

adn make sure that your formulas are correct, and are returning values.

HTH,
Bernie
MS Excel MVP