Code to delete duplicates not working, too slow

[ed333]

I wrote this code to cycle through my table and delete any duplicates. I'm having two problems with it, though. For testing purposes, I've redirected some output to the immediate window. When run it appears to be working, however no dupes are being found. I find this odd, because a find duplicates query run using the same criteria finds about 20000. Also it's slow. Can anyone offer any thoughts about my methods and how to possibly improve them?

thanks,
Ed

'Find dupes in tblDocket, remove dupes with shortest comment length

Public Sub DelDupes()
    'Initialize Recordset
    Dim rs As Recordset
    Dim db As Database
    Dim RecNum, pointer As Long
    Dim DueDate As Date
    Dim Client, File, Act, Pri, Mark, Atty As String
    Dim Month, Day, Year, Comment As Integer
        
    Set db = CurrentDb
    Set rs = db.OpenRecordset("tblDOCKET", dbOpenTable)
    'Set tdf = db.TableDefs!tblDOCKET
    'Set idx = tdf.CreateIndex("RecNumber")
    'Set fld = idx.CreateField("RecordNumber")
    rs.Index = "PrimaryKey"
    rs.MoveFirst
    Do While Not rs.EOF
        ' Set initial conditions to be compared
        RecNum = rs!RecordNumber
        Month = rs!DUEMONTH
        Day = rs!DUEDAY
        Year = rs!DUEYEAR
        DueDate = rs!DueDate
        Client = rs!CLNTNO
        File = rs!FILENO
        Act = rs!ACTREQD
        Pri = rs!PRIORITY
        Mark = rs!MRKD_OFF
        Atty = rs!RATTY
        Comment = Nz(Len(rs!Comment), 0)
        Debug.Print RecNum & ", ";
        rs.MoveNext
        Do Until rs.EOF
            ' Loop through until a dupe is found, and then go to original and delete it
            If rs!DUEDAY = Day And rs!DUEMONTH = Month And rs!DUEYEAR = Year And rs!DueDate = DueDate And rs!CLNTNO = Client And rs!FILENO = File And rs!ACTREQD = Act And rs!PRIORITY = Pri And rs!MRKD_OFF = Mark And rs!RATTY = Atty Then
                rs.Seek "=", RecNum
                rs.Delete
                Debug.Print "*" & RecNum & ", " & rs!RecordNumber & ", "
            End If
            rs.MoveNext
        Loop
        ' Then move to the next record
        rs.Seek "=", RecNum
        rs.MoveNext
    Loop
    rs.Close
End Sub

 

[dcx693]

Why are you even using this code? Since you've already got a query that finds the duplicates, when not then base a delete query on that?

 

[ed333]

Please see http://www.access-programmers.co.uk/forums/showthread.php?t=63432 for a details about this problem. I'm not sure how to turn a find duplicates query into a delete query.

Thanks,
Ed

 

[ed333]

Is there anyone who could help me?


Please?

Thanks
Ed

 

[Mile-O]

Can anyone offer any thoughts about my methods and how to possibly improve them?

My immediate reaction would be to use ealry binding rather than late binding.

i.e.

Month = rs!DUEMONTH becomes Month = rs.Fields("DUEMONTH")

Also, if you use early binding, you can make use of the With...End With structure. i.e.

With rs
 .Index = "PrimaryKey"
    .MoveFirst
    Do While Not .EOF
        ' Set initial conditions to be compared
        RecNum = .Fields("RecordNumber")
        Month = .Fields("DUEMONTH")
        ...etc...
End With

For more info on early and late binding see dcx's post in the FAQ forum.

Regarding dcx's suggestion of a Delete Query based on the Find Duplicates Query, I think that would delete every duplicate in addition to the original.

 

[ed333]

Thank you for the advice. I was not aware of the different binding. I will reasearch this and try to rewrite my code. Is there a speed advantage to early binding?

Thanks,
Ed