[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 363
  • Last Modified:

Delete Duplicate Function

Hi Experts

The below function is working however, it its not deleting the newest record.

Record 1 has a date of 5/17/2001 - I want to delete this date
Record 2 has a date of 10/15/2001 - This is the one that its deleting
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] & '~' & [Allocation Group] AS CompFields, Count([Date Added]) AS RecCount, Max([Date Added]) AS MaxDate FROM [tbl_GMNA Constraint Report Output]" _
             & " GROUP BY  [Constraint Number] & '~' & [Allocation Group]" _
             & " 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 [Allocation Group] = '" & arr(1) & "' " _
             & "AND [Date Added] < #" & rs!MaxDate & "#"
       
        CurrentDb.Execute strSQLDel, dbFailOnError
        rs.MoveNext
    Loop
        
    rs.Close
    Set rs = Nothing
    
'MsgBox "Duplication Check Completed"
End Function

Open in new window

0
mato01
Asked:
mato01
  • 5
  • 3
1 Solution
 
mbizupCommented:
Is DateAdded a true Date field or is it text?

Either way, give this modification a try (this explicitly converts it to a date type):

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] & '~' & [Allocation Group] AS CompFields, Count(CDate([Date Added])) AS RecCount, Max([Date Added]) AS MaxDate FROM [tbl_GMNA Constraint Report Output]" _
             & " GROUP BY  [Constraint Number] & '~' & [Allocation Group]" _
             & " HAVING Count(CDate([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 [Allocation Group] = '" & arr(1) & "' " _
             & "AND CDate([Date Added]) < #" & CDate(rs!MaxDate) & "#"
       
        CurrentDb.Execute strSQLDel, dbFailOnError
        rs.MoveNext
    Loop
        
    rs.Close
    Set rs = Nothing
    
'MsgBox "Duplication Check Completed"
End Function 

Open in new window

0
 
mbizupCommented:
Sorry - misplaced some of the changes in that.

This is corrected:

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] & '~' & [Allocation Group] AS CompFields, Count([Date Added]) AS RecCount, Max(CDate([Date Added])) AS MaxDate FROM [tbl_GMNA Constraint Report Output]" _
             & " GROUP BY  [Constraint Number] & '~' & [Allocation Group]" _
             & " 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 [Allocation Group] = '" & arr(1) & "' " _
             & "AND CDate([Date Added]) < #" & CDate(rs!MaxDate) & "#"
       
        CurrentDb.Execute strSQLDel, dbFailOnError
        rs.MoveNext
    Loop
        
    rs.Close
    Set rs = Nothing
    
'MsgBox "Duplication Check Completed"
End Function 

Open in new window

0
 
mato01Author Commented:
Got a Compile Error: Invalid use of Null

The below line is highlighted in yellow


 Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
mbizupCommented:
Compile error or runtime ??

Can you post a sample?
0
 
mbizupCommented:
Actually, if DateAdded is NULL in any records, give this a try first:


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] & '~' & [Allocation Group] AS CompFields, Count([Date Added]) AS RecCount, Max(CDate(nz([Date Added], #1/1/1900#))) AS MaxDate FROM [tbl_GMNA Constraint Report Output]" _
             & " GROUP BY  [Constraint Number] & '~' & [Allocation Group]" _
             & " 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 [Allocation Group] = '" & arr(1) & "' " _
             & "AND CDate(NZ([Date Added],#1/1/1900#)) < #" & CDate(rs!MaxDate) & "#"
       
        CurrentDb.Execute strSQLDel, dbFailOnError
        rs.MoveNext
    Loop
        
    rs.Close
    Set rs = Nothing
    
'MsgBox "Duplication Check Completed"
End Function  

Open in new window

0
 
mato01Author Commented:
Here is a sample file?

test111.accdb
0
 
mbizupCommented:
This appears to work...

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] & '~' & [Allocation Group] AS CompFields, Count([Date Added]) AS RecCount, Max(CDate(NZ([Date Added],#1/1/1900#))) AS MaxDate FROM [tbl_GMNA Constraint Report Output]" _
             & " GROUP BY  [Constraint Number] & '~' & [Allocation Group]" _
             & " 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 [Allocation Group] = '" & arr(1) & "' " _
             & "AND CDate(NZ([Date Added],#1/1/1900#)) < #" & CDate(rs!MaxDate) & "#"
       
        CurrentDb.Execute strSQLDel, dbFailOnError
        rs.MoveNext
    Loop
        
    rs.Close
    Set rs = Nothing
    
'MsgBox "Duplication Check Completed"
End Function

Open in new window

0
 
mato01Author Commented:
This solution seems to work.  Thanks
0

Featured Post

Vote for the Most Valuable Expert

It’s time to recognize experts that go above and beyond with helpful solutions and engagement on site. Choose from the top experts in the Hall of Fame or on the right rail of your favorite topic page. Look for the blue “Nominate” button on their profile to vote.

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