• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 691
  • Last Modified:

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

0
mato01
Asked:
mato01
1 Solution
 
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 MVP, Access and Data Platform)Commented:
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
 
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
Free Backup Tool for VMware and Hyper-V

Restore full virtual machine or individual guest files from 19 common file systems directly from the backup file. Schedule VM backups with PowerShell scripts. Set desired time, lean back and let the script to notify you via email upon completion.  

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

Featured Post

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now