Pwning lame ass dupes in excel

February 12, 2008

Well a friend wrote some bitching code. So we thought we should share.

Sub Remove_Dups()
‘much faster dup remover but has dependencies and preparations:
‘1. there must not be over 500 dups of a certain thing, this will only
‘   remove up to 500 dups of each item, must run again if more
‘2. you are required to order the table based on column 1
‘3. column 1 is the only field checked
‘4. only deletes the cell instead of row to keep in order.
‘5. re-sort table based on column 1 and remove all rows with empty first cell
‘6. add THEEND to first cell of a row at the bottom so dup checker
‘   will stop once it gets there
Application.ScreenUpdating = True

Dim x As Long
Dim y As Long

For x = 1 To 59999
    Sheets("Sheet1").Cells(x, 1).Select
    If Sheets("Sheet1").Cells(x, 1).Value = "THEEND" Then
        MsgBox "Done!"
        Exit Sub
    End If
    If Not x = 59999 Then
        For y = (x + 1) To (x + 500)
            If Not Sheets("Sheet1").Cells(y, 1).Value = "" Then
                If Sheets("Sheet1").Cells(y, 1).Value = Sheets("Sheet1").Cells(x, 1).Value Then
                    Sheets("Sheet1").Cells(y, 1).Value = ""
                    DoEvents
                    Sheets("Sheet1").Cells(x, 1).Select
                End If
            End If
        Next y
    End If
Next x

MsgBox "Done!"

End Sub
 

Got something to say?

You must be logged in to post a comment.