Eliminate Duplicates

[Guest]

I have a single column with numbers from which I want to eliminate duplicates.
The colums can be sorted, but one number for which duplicate(s) exist must
remain.

There are, however, no fixed amount of entries in the column.

I tried

Sub RemoveDupes()

'Add extra Column, "A" becomes "B"
Columns(1).EntireColumn.Insert

'Filter out duplicates and copy unique list to "A"
Range("B1", Range("B65536").End(xlUp)).AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=Range("A1"), Unique:=True

'Add extra Column, "B" becomes "A"
Columns(2).EntireColumn.Delete


but nothing happens...

 

[Guest]

Try this:

Sub RemoveDupes()
Range("A1").Select
Columns("A:A").AdvancedFilter Action:=xlFilterCopy,
CopyToRange:=Columns( _
"B:B"), Unique:=True
Columns("B:B").Select
Selection.Cut
Columns("A:A").Select
ActiveSheet.Paste
End Sub

Regards,
Stefi

„Felix†ezt írta:

 

[Guest]

Sub RemoveDupes1()

With Cells

Set rng = .Range(.Cells(1, 2), .Cells(1, 2).End(xlDown))
rng.Select
End With

Dim RowNdx As Long
Dim ColNum As Integer
ColNum = Selection(1).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).EntireRow.Delete shift:=xlUp
End If
Next RowNdx
End Sub

 

[Guest]

For Column "A"

Set rng = .Range(.Cells(1, 1), .Cells(1, 1).End(xlDown))

Forgot to make the change.

 

[Guest]

I tried to write this macro:

It would not accept the following line(s)

Columns("A:A").AdvancedFilter Action:=xlFilterCopy,
CopyToRange:=Columns( _
"B:B"), Unique:=True

 

[Guest]

Hello Jim,

I tried your macro as follows:

Col. A with data (numbers) (sorted)

Then I selected the cells ( A1:A313) and ran the macro with corrected line:

Set rng = .Range(.Cells(1, 1), .Cells(1, 1).End(xlDown))
rng.Select

I get Error message with "400" before the End If

 

[Guest]

I ran it again to make sure I didn't screw anything up and it worked just
fine for me. What message did the error message have?

 

[Guest]

Sorry Jim,

now it works...

I must have screwed up something running it.

I had to sort first so that all duplicates are together. This is necessary,
I guess. OK?

 

[Ricco]

I discovered this on a website - It will work whether the data is
sorted to get duplicates together or not and is only suitable if you
want to delete a entire row of data


Public Sub DeleteDuplicateRows()
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' DeleteDuplicateRows
' This will delete duplicate records, based on the Active Column. That
is,
' if the same value is found more than once in the Active Column, all
but
' the first (lowest row number) will be deleted.
'
' To run the macro, select the entire column you wish to scan for
' duplicates, and run this procedure.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim R As Long
Dim N As Long
Dim V As Variant
Dim Rng As Range

On Error GoTo EndMacro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual


Set Rng = Application.Intersect(ActiveSheet.UsedRange, _
ActiveSheet.Columns(ActiveCell.Column))

Application.StatusBar = "Processing Row: " & Format(Rng.Row, "#,##0")

N = 0
For R = Rng.Rows.Count To 2 Step -1
If R Mod 500 = 0 Then
Application.StatusBar = "Processing Row: " & Format(R, "#,##0")
End If

V = Rng.Cells(R, 1).Value
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Note that COUNTIF works oddly with a Variant that is equal to
vbNullString.
' Rather than pass in the variant, you need to pass in vbNullString
explicitly.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If V = vbNullString Then
If Application.WorksheetFunction.CountIf(Rng.Columns(1),
vbNullString) > 1 Then
Rng.Rows(R).EntireRow.Delete
N = N + 1
End If
Else
If Application.WorksheetFunction.CountIf(Rng.Columns(1), V) > 1
Then
Rng.Rows(R).EntireRow.Delete
N = N + 1
End If
End If
Next R

EndMacro:

Application.StatusBar = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Duplicate Rows Deleted: " & CStr(N)

End Sub