Duplicate Rows

[Edgar]

Hi

I am using the following script to sort a list of numbers
and then delete all multiple entries.

The problem i have is the list is very long (roughly
60,000 lines) and every time i run this script it seems to
crash my computer. Is there any other way of doing this or
does anyone have any idea roughly how long this should
take on a new P4 with 128ram?

Please help otherwise i may have to manually delete all
multiple lines!!!! (ohh the boredom)

Sub FixDuplicateRows()

Columns("A:B").Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending,
Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal



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).Value = Delete
End If
Next RowNdx

 

[RADO]

Much better way to accomplish this task is to use Advanced Filter:

1) Insert a new sheet
2) Select any cell in the middle of the new sheet
3) Go to data/advanced filter menu
4) in the form, enter as a "list range" reference to your list , live
criteria blank, click "unique records only". Finally, select Copy to a
different location, and enter any cell on your sheet where you want the
resulting list to start.

Should take seconds.
Best -

Rado

 

[RADO]

by the way, you can use VBA to accomplish the same task:
1) You have to name your list: select it and name "Source"
2) Then use this code:

Sub RemoveDups
Dim Target As Range
Dim Source As Range

Worksheets.Add
Set Source = Range("Source")
Set Target = ActiveSheet.Cells(1,1)

Source.AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Target, _
Unique:=True
End Sub

Cheers
RADO