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

mato01Asked:
Who is Participating?
 
mbizupCommented:
This should do it...

It is the same idea, but it combines the fields whic you are checking for matches in the SELECT and GROUP BY clauses.  They get split up again using the Split() function after the recordset is opened, and used as criteria for determining duplicate records  The same method is then used to delete the older duplicates:

Function DeleteDupes()
    Dim strSQL As String
    Dim strSQLDel As String
    Dim rs As DAO.Recordset
    Dim arr() As String
    
   ' This query selects the max date, grouping by Constraint Number, only considering records that have duplicates

     strSQL = "SELECT  [Constraint Number] & '~' & [Allo Number] & '~' & [md code] AS CompFields, Count([Date Added]) AS RecCount, Max([Date Added]) AS MaxDate FROM [tbl_GMNA Constraint Report Output]" _
             & " GROUP BY  [Constraint Number] & '~' & [Allo Number] & '~' & [md code]" _
             & " 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
        arr = Split(rs!CompFields, "~")
        strSQLDel = "DELETE * FROM [tbl_GMNA Constraint Report Output] WHERE " _
             & "[Constraint Number] = '" & arr(0) & "' " _
             & "AND [Allo Number] = '" & arr(1) & "' " _
             & "AND [md code] = '" & arr(2) & "' " _
             & "AND [Date Added] < #" & rs!MaxDate & "#"
        CurrentDb.Execute strSQLDel, dbFailOnError
        rs.MoveNext
    Loop
        
    rs.Close
    Set rs = Nothing
End Function

Open in new window

0
 
ErezMorCommented:
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
0
 
DatabaseMX (Joe Anderson - Microsoft Access MVP)Database ArchitectCommented:
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
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

 
mbizupCommented:
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

0
 
mato01Author Commented:
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.
0
 
mato01Author Commented:
This worked without error.  I do need to expand on this, so I will open another question.  Thanks for your help.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.