Extract duplicate records

[QueenS]

Hi

I've just gone through a cumbersome process of trying to extract duplicate records from a huge masterfile of 600K+ records.

I've scoured the web and I must say, there's a lot of fake sites out there and then some which are trying to get people to pay for the answers which is really frustrating. So thank you MrExcel.com for being a really genuine website with awesome reliable knowledge base to draw on.

Having said that, I put forth my issue and hope someone with superior knowledge can make my work easier.

thanks to mirabeau, i was able to use the code posted on: http://www.mrexcel.com/forum/showthread.php?t=526956

except that it just removed the duplicate records to the "Duplicates" spreadsheet and kept the unique ones.

What I want is a total separation of duplicate records and unique ones with all duplicate records separated onto the "Duplicates" spreadsheet - so that no record has a duplicate in the other spreadsheet.

Help!

 

[AlphaFrog]

Modified mirabeau's code

Sub duplicstuff()
    Dim t      As Single
    t = Timer
    Dim d As Object, x&, xcol As String
    Dim lc&, lr&, k(), [COLOR="Red"]e[/COLOR]
    xcol = [COLOR="Red"]"A"[/COLOR]
    lc = Cells.Find("*", after:=[a1], searchdirection:=xlPrevious).Column
    lr = Cells.Find("*", after:=[a1], searchdirection:=xlPrevious).Row
    ReDim k(1 To lr, 1 To 1)
    Set d = CreateObject("scripting.dictionary")
  [COLOR="Red"]  e = Cells(1, xcol).Resize(lr)
    For x = 1 To lr
        If Not d.exists(e(x, 1)) Then
            d(e(x, 1)) = x
            k(x, 1) = 1
        Else
            k(d(e(x, 1)), 1) = ""
        End If
    Next x[/COLOR]
    If d.Count = lr Then
        MsgBox "No duplicates"
        Exit Sub
    End If
    Cells(1, lc + 1).Resize(lr) = k
    Range("A1", Cells(lr, lc + 1)).Sort Cells(1, lc + 1), 1
    x = Cells(1, lc + 1).End(4).Row
    Cells(x + 1, 1).Resize(lr - x, lc).Copy Sheets("Duplicates").Range("A1")
    Cells(x + 1, 1).Resize(lr - x, lc).Clear
    Cells(1, lc + 1).Resize(x).Clear
    MsgBox "Code took " & Format(Timer - t, "0.00 secs")
    MsgBox lr & " rows" & vbLf & lc & " columns" & vbLf & _
           lr - x & " duplicate rows"
End Sub

 

[QueenS]

Amazing! worked like a charm!

thanks so much!