Mark duplicates without deleting them

[igillesp]

Hi all!

I wonder if anyone can help?

I have a table (FoodCore) which contains duplicate entries (up to ~10) based on five fields (Dup, CleanedRef, YearOfReceipt, LB2LabName & SeroAFLP). I want to identify these (in the Dup field) but not delete them. I could just mark them via a query, but they will still be identical, so I need to assign a sequential number to them.

My idea was to create a recordset of the duplicate records, and then use the parameters from each entry to create a second recordset to populate the Dup field via a counter.

However, I'm still new to VBA and when I run the code below it just hangs.

Any ideas?

Thanks,

Iain

Private Sub cmdFoodCoreDups_Click()
 
Dim db As Database
Dim rsDup, rsEdit As DAO.Recordset
Dim sSQL1, sSQL2 As String
Set db = CurrentDb
 
       'Identify the duplicate entries
 
    sSQL1 = "SELECT FoodCore.Dup, FoodCore.CleanedRef, FoodCore.YearOfReceipt, " & _
            "FoodCore.LB2LabName, FoodCore.SeroAFLP, Count(FoodCore.MOLISid) AS [Count] " & _
            "FROM FoodCore " & _
            "GROUP BY FoodCore.Dup, FoodCore.CleanedRef, FoodCore.YearOfReceipt, " & _
            "FoodCore.LB2LabName, FoodCore.SeroAFLP " & _
            "HAVING (((Count(FoodCore.MOLISid))>1));"
 
    Set rsDup = db.OpenRecordset(sSQL1)
    ' Define a new recordset for each set of duplicates identified above
 
    Do While Not rsDup.EOF
 
        Dim Dup, Ref, Lab, LmType As String
        Dim Year As Integer
 
        Dup = rsDup!Dup
        Ref = rsDup!CleanedRef
        Year = rsDup!YearOfReceipt
        Lab = rsDup!LB2LabName
        LmType = rsDup!SeroAFLP
 
        sSQL2 = "Select * from FoodCore WHERE FoodCore.Dup = '" & Dup & "' AND " & _
                "FoodCore.CleanedRef = '" & Ref & "' AND " & _
                "FoodCore.YearOfReceipt = " & Year & " AND " & _
                "FoodCore.LB2LabName = '" & Lab & "' AND " & _
                "FoodCore.SeroAFLP = '" & LmType & "';"
 
        Set rsEdit = db.OpenRecordset(sSQL2)
 
        ' Declare a Counter and use this to put a value into the Dup field,
        ' making each entry unique within the duplicate set
 
        Dim Counter As Integer
            Counter = 0
        Do While Not rsEdit.EOF
 
            With rsEdit
                .Edit
                ![Dup] = Counter
                .Update
                Counter = Counter + 1
                .MoveNext
            End With
        Loop
        rsEdit.Close
        Set rsEdit = Nothing
 
      rsDup.MoveNext
 
    Loop
 
End Sub

 

[igillesp]

Solved!

It didn't like the...

sSQL2 = "Select * from FoodCore WHERE FoodCore.Dup = '" & Dup & ...etc

... as the Dup field was blank.

Final code below in case its of use:

Dim db As Database
Dim rsDup, rsEdit, rsUni As DAO.Recordset
Dim sSQL1, sSQL2, sSQL3 As String

Set db = CurrentDb
    
    'Clear the current values in the Dup field
    
    DoCmd.SetWarnings False
        
    DoCmd.RunSQL "UPDATE FoodCore SET FoodCore.Dup = Null;"
    
    'Identify the duplicate entries
    
    sSQL1 = "SELECT FoodCore.Dup, FoodCore.CleanedRef, FoodCore.YearOfReceipt, " & _
            "FoodCore.LB2LabName, FoodCore.SeroAFLP, Count(FoodCore.MOLISid) AS [Count] " & _
            "FROM FoodCore " & _
            "GROUP BY FoodCore.Dup, FoodCore.CleanedRef, FoodCore.YearOfReceipt, " & _
            "FoodCore.LB2LabName, FoodCore.SeroAFLP " & _
            "HAVING (((Count(FoodCore.MOLISid))>1));"
    
    Set rsDup = db.OpenRecordset(sSQL1)

    ' Define a new recordset for each set of duplicates identified above
    
    Do While Not rsDup.EOF
    
        Dim Ref, Lab, LmType As String
        Dim Year As Integer
        
        Ref = rsDup!CleanedRef
        Year = rsDup!YearOfReceipt
        Lab = rsDup!LB2LabName
        LmType = rsDup!SeroAFLP
        
        sSQL2 = "Select * from FoodCore WHERE FoodCore.CleanedRef = '" & Ref & "' AND " & _
                "FoodCore.YearOfReceipt = " & Year & " AND " & _
                "FoodCore.LB2LabName = '" & Lab & "' AND " & _
                "FoodCore.SeroAFLP = '" & LmType & "';"
       
        Set rsEdit = db.OpenRecordset(sSQL2)
                
        ' Declare a Counter and use this to put a value into the Dup field,
        ' making each entry unique within the duplicate set
        
        Dim Counter As Integer
            Counter = 0

        Do While Not rsEdit.EOF
            
            With rsEdit
                .Edit
                ![Dup] = Counter
                .Update
                Counter = Counter + 1
                .MoveNext
            End With

        Loop

        rsEdit.Close
        Set rsEdit = Nothing
        
      rsDup.MoveNext
        
    Loop
        
        'Identify the unique entries and put a zero in the Dup field for these records
          
    sSQL3 = "SELECT FoodCore.Dup FROM FoodCore WHERE FoodCore.Dup Is Null"
    Set rsUni = db.OpenRecordset(sSQL3)
    
    Do While Not rsUni.EOF
        
        With rsUni
             .Edit
             ![Dup] = 0
             .Update
             .MoveNext
        End With
        
    Loop
    
    DoCmd.SetWarnings False

    MsgBox "Food Core de-duplicated successfully"

Iain