PDA

View Full Version : Solved: Removing All Duplicates



pickens11735
05-24-2008, 10:51 AM
I'm very inexperienced in Excel. Reading your posts, I know I came to the right place.

I want a script that will delete all duplicate rows.

In the program below, if it finds duplicates in column "c", it will delete all duplicate rows except one. That's helpful, but not exactly what I want.

I want, if there are any duplicates in row "c", I want the script to remove all the duplicate rows.

Can you help me?

Sub DeleteDupsButOne()

Dim x As Long
Dim LastRow As Long

LastRow = Range("c65536").End(xlUp).Row
For x = LastRow To 1 Step -1
If Application.WorksheetFunction.CountIf(Range("c1:c" & x), Range("c" & x).Text) > 1 Then
Range("c" & x).EntireRow.Delete
End If
Next x

End Sub

Aussiebear
05-24-2008, 06:26 PM
HI pickens11735, Welcome to vbax. DRJ has the following in the kb

Option Explicit

Sub DeleteDups()

Dim x As Long
Dim LastRow As Long

LastRow = Range("A65536").End(xlUp).Row
For x = LastRow To 1 Step -1
If Application.WorksheetFunction.CountIf(Range("A1:A" & x), Range("A" & x).Text) > 1 Then
Range("A" & x).EntireRow.Delete
End If
Next x

End Sub

Change the column indicator from A to C

pickens11735
05-24-2008, 07:21 PM
Moderator, thank you very much, but that is the same program I have listed above. I got it from this website.

That program and the one you have, eliminates all duplicates, and leaves the unique value. I want to eliminate all the duplicated values.

For example, let's say the values are
12
11
10
10
9
8

The program I showed above and your program will return 12, 11, 10, 9, 8

I want a program that will eliminate all the numbers that are duplicate and return 12, 11, 9, 8.

Can you help me?

Tom527
05-24-2008, 08:02 PM
This is not as pretty as a someone who does alot with VBA but this will do what you are looking for:

Option Explicit

Sub DeleteDups()

Dim x As Long
Dim LastRow As Long
Dim rowNumber As Variant
Dim valfound As Long
On Error Resume Next
LastRow = Range("A65536").End(xlUp).Row
For x = LastRow To 1 Step -1
If Application.WorksheetFunction.CountIf(Range("A1:A" & x), Range("A" & x).Text) > 1 Then
valfound = Range("A" & x).Value
Do
rowNumber = Application.Match(valfound, Range("A:A"), 0)
Range("a" & rowNumber).EntireRow.Delete
Loop While Err = 0
Err = 0

End If
Next x

End Sub

pickens11735
05-25-2008, 04:50 AM
Thank you. It works great.

That worked for the values that were only numbers. I'm sorry. I was not clear. I also have text in the column too. It is addresses, like

100 main street
100 main street
110 main street
110 walker street
120 smith street

I'd want the program to return
110 main street
110 walker street
120 smith street

Bob Phillips
05-25-2008, 05:02 AM
Sub DeletDuplicates()
Dim LastRow As Long
Dim rng As Range

With Application

.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

With ActiveSheet

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("B1").Resize(LastRow).Formula = "=COUNTIF(A:A,A1)"
.Rows(1).Insert
.Range("B1").Value = "Temp"
.Range("B1").AutoFilter Field:=2, Criteria1:=">1", Operator:=xlAnd
Set rng = .Range("B1").Resize(LastRow + 1).SpecialCells(xlCellTypeVisible)
rng.EntireRow.Delete
End With

With Application

.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With

End Sub

Tom527
05-25-2008, 05:33 AM
if you change :
DIm valfound as long
to
Dim valfound as string

it should work

pickens11735
05-25-2008, 05:42 AM
Thank you all very much for your help and patience with me.

You are all experts as far as I'm concerned.

Take care,
Alex

Aussiebear
05-25-2008, 05:53 AM
Alex, if you are happy to mark this thread "Solved" then use the Thread tools to do so. Zoom back to your first post, and about 2/3's of the way across you'll notice Thread Tools, click on this and then select the Mark Solved option.

Thank you for the feedback.