Compile Error: Runtime Error 3167 Record is deleted

Help Experts

This function was working, but now that I have placed it behind a button, it is giving me the error message. I had opened up another question, without resolve, so I'm asking this related question from previous communications on the code

Compile Error Runtime Error 3167 Record is deleted.

If temp = rst![Constraint Number] Then

Option Compare Database

Function DeleteDuplicates()

    Dim DeleteCount As Long ' Make this a Long if you really have that many records
    Dim temp
    Dim sql As String
    Dim sql2 As String
    Dim rst As DAO.Recordset
    Dim rst2 As DAO.Recordset
    Dim datMax As Date

 
    '' Change DESC to ASC to keep the older record
    '' Leave DESC to keep the newer record
    sql = "SELECT [tbl_GMNA Constraint Report Output].* FROM [tbl_GMNA Constraint Report Output] ORDER BY [tbl_GMNA Constraint Report Output].[Constraint Number] DESC"

    Set rst = CurrentDb.OpenRecordset(sql, dbOpenDynaset)

    If rst.EOF Then
        MsgBox "There are no records in this table!"
        Exit Function
    End If
        
    

    rst.MoveFirst
    Do Until rst.EOF
 
      If temp = rst![Constraint Number] Then
        
      
        sql2 = "SELECT [tbl_GMNA Constraint Report Output].* FROM [tbl_GMNA Constraint Report Output]"
                  sql2 = sql2 & " WHERE [Constraint Number]='" & rst.Fields("Constraint Number")
                  sql2 = sql2 & "' ORDER BY [tbl_GMNA Constraint Report Output].[Constraint Number] DESC"
                  
                  
                  Set rst2 = CurrentDb.OpenRecordset(sql2, dbOpenDynaset)
                  
                                   
                  datMax = rst2.Fields("Date Added").Value & vbNullString
                  'datMax = rst2.Fields("Date Added").Value & vbNullString


      
            If rst2.RecordCount > 1 Then
            
            sql2 = "Delete * From [tbl_GMNA Constraint Report Output] WHERE [Constraint Number]=" & Chr(34) & rst("Constraint Number") & Chr(34)
            sql2 = sql2 & " AND [Date Added] <> #" & datMax & "#"
                
            
            
            CurrentDb.Execute sql2
            
            End If
       
            rst2.Close
            
            DeleteCount = DeleteCount + 1
        Else
            temp = rst![Constraint Number]
        End If
        rst.MoveNext
    Loop
    Set rst = Nothing
    Set rst2 = Nothing
    MsgBox "Found and deleted " & CStr(DeleteCount) & " records  - Constraint Process Completed."
    

End Function

Open in new window

Microsoft Access

Last Comment

mato01

8/22/2022 - Mon

ErezMor

10/6/2011

there seems to be inherent problem: you are deleting row/s within a loop that runs through those same rows, it's just matter of chance that it didnt happen before.

one way is to add a "ToBeDeleted" boolean field to the table, and only update it while looping, then, only after exiting the loop run a single sql delete for all records that has the ToBeDeleted filed=true

DatabaseMX (Joe Anderson - Former Microsoft Access MVP)

10/6/2011

Again ... this line:

If temp = rst![Constraint Number] Then

makes not sense because temp has never been given a value to test against some other value.

Also ... did you try what I last posted in the other Q ?

Does your app compile ... VBA Menu>>Debug>>Compile ?

mx

mbizup

10/6/2011

ErezMor is right about the reason for the error that you are getting.

However from the related question you have linked to, it sounds like you are simply trying to delete any duplicates, keeping only the record with the most current date.

The code for that can be simplified a lot, without risking that error (which comes from your code attempting to delete a record that has already been deleted).

You can use an aggegate query to select the max date of records that contain duplicates, and then use a single loop to go through that recordset, deleteing records with matching constraint numbers, but dates that are less than that max date. Double-check all of the table and fieldnames here:

Function DeleteDupes()
    Dim strSQL As String
    Dim strSQLDel As String
    Dim rs As DAO.Recordset
    
   ' This query selects the max date, grouping by Constraint Number, only considering records that have duplicates
    strSQL = "SELECT [Constraint Number] as ConNo, Count([Date Added]) AS RecCount, Max([Date Added]) AS MaxDate FROM [tbl_GMNA Constraint Report Output]" _
             & " GROUP BY [Constraint Number]" _
             & " HAVING Count([Date Added]) > 1"
             
    Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
    If rs.RecordCount = 0 Then
        MsgBox "No dupes found"
        Exit Function
    End If
    
    'Loop through the recordset deleting duplicates with the same constraint number but lesser dates
    Do Until rs.EOF
        strSQLDel = "DELETE * FROM [tbl_GMNA Constraint Report Output] WHERE [Constraint Number] = '" & rs!ConNo & "' AND [Date Added] < #" & rs!MaxDate & "#"
        CurrentDb.Execute strSQLDel, dbFailOnError
        rs.MoveNext
    Loop
        
    rs.close
    set rs = nothing
End Function

Open in new window

Experts Exchange has (a) saved my job multiple times, (b) saved me hours, days, and even weeks of work, and often (c) makes me look like a superhero! This place is MAGIC!

Walt Forbes

mato01

10/7/2011

ASKER

This seems to work, but I need to delete records with matching [constraint number], [allo number], and [md code], but leave dates that are less than the that max date. This will leave me with newest entry.

ASKER CERTIFIED SOLUTION

mbizup

10/7/2011

Become an EE member today7-DAY FREE TRIAL

Members can start a 7-Day Free trial then enjoy unlimited access to the platform

Learn why we charge membership fees

We get it - no one likes a content blocker. Take one extra minute and find out why we block content.

Not exactly the question you had in mind?

Sign up for an EE membership and get your own personalized solution. With an EE membership, you can ask unlimited troubleshooting, research, or opinion questions.

ask a question

mato01

10/8/2011

ASKER

This worked without error. I do need to expand on this, so I will open another question. Thanks for your help.