deleting a duplicate record based on the most current date

[mcca0081]

hi - i'm trying to delete one of the duplicate records based on the
most current date.

here's the code for my access 2000 db. any help would be
appreciated!!! - thank you kindly

Sub DeleteDuplicateRecords()
' Deletes duplicates from the specified table, keeping the most
current received date record.
' No user confirmation is required.
Dim rst As DAO.Recordset
Dim rst2 As DAO.Recordset
Dim tdf As DAO.TableDef
Dim fld As DAO.Field
Dim strSQL As String
Dim varBookmark As Variant
strTableName = "tlbtest1"
Set tdf = DBEngine(0)(0).TableDefs(strTableName)
strSQL = "SELECT tlbtest1.[num], tlbtest1.[Rcvddate]" _
& "FROM tlbtest1 " _
& "ORDER BY tlbtest1.[num], tlbtest1.[RcvdDate] DESC;"

'Set tdf = Nothing
Debug.Print strSQL
Set rst = CurrentDb.OpenRecordset(strSQL)
Set rst2 = rst.Clone
rst.MoveNext
Do Until rst.EOF
varBookmark = rst.Bookmark
For Each fld In rst.Fields
If fld.Value <rst2.Fields(fld.Name).Value Then
GoTo NextRecord
End If
Next fld
rst.Delete
GoTo SkipBookmark
NextRecord:
rst2.Bookmark = varBookmark
SkipBookmark:
rst.MoveNext
Loop
End Sub

[lgeastwood]

On May 4, 4:29 pm, mcca0081 <[e-mail]:

hi - i'm trying to delete one of the duplicate records based on the
most current date.

here's the code for my access 2000 db. any help would be
appreciated!!! - thank you kindly

Sub DeleteDuplicateRecords()
' Deletes duplicates from the specified table, keeping the most
current received date record.
' No user confirmation is required.
Dim rst As DAO.Recordset
Dim rst2 As DAO.Recordset
Dim tdf As DAO.TableDef
Dim fld As DAO.Field
Dim strSQL As String
Dim varBookmark As Variant
strTableName = "tlbtest1"
Set tdf = DBEngine(0)(0).TableDefs(strTableName)
strSQL = "SELECT tlbtest1.[num], tlbtest1.[Rcvddate]" _
& "FROM tlbtest1 " _
& "ORDER BY tlbtest1.[num], tlbtest1.[RcvdDate] DESC;"

'Set tdf = Nothing
Debug.Print strSQL
Set rst = CurrentDb.OpenRecordset(strSQL)
Set rst2 = rst.Clone
rst.MoveNext
Do Until rst.EOF
varBookmark = rst.Bookmark
For Each fld In rst.Fields
If fld.Value <rst2.Fields(fld.Name).Value Then
GoTo NextRecord
End If
Next fld
rst.Delete
GoTo SkipBookmark
NextRecord:
rst2.Bookmark = varBookmark
SkipBookmark:
rst.MoveNext
Loop
End Sub

One of my favorite method is to use a list or combo box based on the
record set
Set one of the columns to the date field in your table
Then use the listindex method to move to the sorted listbox item and
extract the date in the date column. Use the extracted date in a SQL
statement of a simple delete query and presto, all records without the
date will be deleted. Of course if you have records with the same date
you might need to use the date/time format to ensure the very latest
updated duplicate record.
Question: instead of duplicating records why not overwrite the older
one at time of update?

[CDMAPoster]

On May 4, 3:29 pm, mcca0081 <[e-mail]:

hi - i'm trying to delete one of the duplicate records based on the
most current date.

here's the code for my access 2000 db. any help would be
appreciated!!! - thank you kindly

Sub DeleteDuplicateRecords()
' Deletes duplicates from the specified table, keeping the most
current received date record.
...
Set rst = CurrentDb.OpenRecordset(strSQL)
Set rst2 = rst.Clone

I was able to delete directly from the original table, but it involved
using the []. subquery syntax. It's a little easier to create a new
table with just the records you want. The recordset technique with a
clone that you used looked too gnarly for me to start from.

'-----Begin Module Code-----
Sub KeepUnique(strTableName As String, strDateField As String,
strIDField As String, strMakeTableName As String)
Dim MyDB As Database
Dim CountRS As Recordset
Dim strSQL As String
Dim boolExecute As Boolean
Dim tdf As TableDef
Dim fld As Field
Dim lngCount As Long
Dim strLastField As String

Set MyDB = CurrentDb
Set tdf = MyDB.TableDefs(strTableName)
boolExecute = False
'SELECT First(tblOrders.OID) AS OID FROM tblOrders WHERE OrderDate =
(SELECT Min(A.OrderDate) FROM tblOrders AS A WHERE A.OrderData =
tblOrders.OrderData AND A.Other = tblOrders.Other) GROUP BY OrderData,
Other;
strSQL = ""
If tdf.Fields.Count = 0 Then
MsgBox ("No fields in table " & strTableName)
Set tdf = Nothing
Set MyDB = Nothing
Exit Sub
End If
strSQL = "SELECT First(" & strTableName & "." & strIDField & ") AS " &
strIDField & " FROM " & strTableName
strSQL = strSQL & " WHERE " & strDateField & " = (SELECT Min(A." &
strDateField & ") FROM " & strTableName & " AS A WHERE "
For Each fld In tdf.Fields
If fld.Name <strIDField And fld.Name <strDateField Then ' And
fld.Name <any field not used to determine uniqueness
strSQL = strSQL & "A." & fld.Name & " = tblOrders." & fld.Name & "
AND "
End If
Next fld
strSQL = Left(strSQL, Len(strSQL) - 5)
strSQL = strSQL & ") GROUP BY "
For Each fld In tdf.Fields
If fld.Name <strIDField And fld.Name <strDateField Then ' And
fld.Name <any field not used to determine uniqueness
strSQL = strSQL & fld.Name & ", "
End If
Next fld
strSQL = Left(strSQL, Len(strSQL) - 2) & ";"
Set CountRS = MyDB.OpenRecordset(strSQL, dbOpenSnapshot)
If CountRS.RecordCount 0 Then
boolExecute = True
CountRS.MoveLast
lngCount = CountRS.RecordCount
End If
CountRS.Close
Set CountRS = Nothing
'SELECT * INTO tblKeep FROM tblOrders WHERE OID In (SELECT
First(A.OID) AS OID FROM tblOrders AS A WHERE A.OrderDate = (SELECT
Min(B.OrderDate) FROM tblOrders AS B WHERE B.OrderData = A.OrderData
AND B.Other = A.Other) GROUP BY A.OrderData, A.Other);
If boolExecute = True Then
'Place any unique records in strMakeTableName
'Always nuke the old table
If IsTable(strMakeTableName) Then
MyDB.TableDefs.Delete strMakeTableName
DoEvents
End If
strSQL = "SELECT * INTO " & strMakeTableName & " FROM " &
strTableName & " WHERE " & strIDField & " IN (SELECT First(A." &
strIDField & ") "
strSQL = strSQL & "AS " & strIDField & " FROM " & strTableName & "
AS A WHERE A." & strDateField & " = (SELECT Min(B." & strDateField &
") FROM " & strTableName & " AS B WHERE "
For Each fld In tdf.Fields
If fld.Name <strIDField And fld.Name <strDateField Then ' And
fld.Name <any field not used to determine uniqueness
strSQL = strSQL & "B." & fld.Name & " = A." & fld.Name & " AND "
End If
Next fld
strSQL = Left(strSQL, Len(strSQL) - 5)
strSQL = strSQL & ") GROUP BY "
For Each fld In tdf.Fields
If fld.Name <strIDField And fld.Name <strDateField Then ' And
fld.Name <any field not used to determine uniqueness
strSQL = strSQL & "A." & fld.Name & ", "
End If
Next fld
strSQL = Left(strSQL, Len(strSQL) - 2) & ");"
MyDB.Execute strSQL, dbFailOnError
If lngCount 1 Then
Do While MyDB.RecordsAffected = 0
DoEvents
Loop
End If
Else
MsgBox ("No duplicate records.")
End If
End Sub

Public Function IsTable(strTableName As String)
Dim MyDB As Database
Dim tdf As TableDef
Dim tdfs As TableDefs

IsTable = False
Set MyDB = CurrentDb
Set tdfs = MyDB.TableDefs
For Each tdf In tdfs
If tdf.Name = strTableName Then
IsTable = True
Exit For
End If
Next tdf
End Function
'-------End Module Code-----

Sample call:

Call KeepUnique("tblOrders", "OrderDate", "OID", "tblKeep")

The test I ran:

tblOrders
OID AutoNumber
OrderData Text
OrderDate Date/Time
Other Text
OID OrderData OrderDate Other
1 qa 4/5/2007 1
2 qb 4/5/2007 1
3 qc 4/6/2007 2
4 qc 4/6/2007 2
7 qb 4/8/2007 3
8 qb 4/7/2007 3
9 qb 4/6/2007 3

After calling the subroutine:

tblKeep
OID OrderData OrderDate Other
1 qa 4/5/2007 1
2 qb 4/5/2007 1
3 qc 4/6/2007 2
9 qb 4/6/2007 3

This is the only test I tried. You'll need to change from Min to Max
on the date field everywhere. You'll also need to undo any browser
wordwrap. I might still have the sample []. subquery SQL statement
around if the MakeTable query won't do. I hope this helps.

James A. Fortune
CD********@FortuneJames.com

[CDMAPoster]

On May 6, 10:24 pm, [e-mail] wrote:

I might still have the sample []. subquery SQL statement
around if the MakeTable query won't do. I hope this helps.

I found it. Make a backup first if you decide to run it. Maybe
there's a simpler way to keep the most recent duplicated record and to
delete the rest directly from the table using a single query.

DELETE tblOrders FROM tblOrders WHERE OID IN (SELECT tblOrders.OID
FROM tblOrders LEFT JOIN [SELECT OID FROM tblOrders WHERE OID IN
(SELECT First(A.OID) AS OID FROM tblOrders AS A WHERE A.OrderDate =
(SELECT Max(B.OrderDate) FROM tblOrders AS B WHERE B.OrderData =
A.OrderData AND B.Other = A.Other) GROUP BY A.OrderData, A.Other)]. AS
qryKeep ON tblOrders.OID = qryKeep.OID WHERE qryKeep.OID Is Null);

James A. Fortune
CD********@FortuneJames.com

[DavidB]

On May 4, 4:29 pm, mcca0081 <[e-mail]:

hi - i'm trying to delete one of the duplicate records based on the
most current date.

here's the code for my access 2000 db. any help would be
appreciated!!! - thank you kindly

Sub DeleteDuplicateRecords()
' Deletes duplicates from the specified table, keeping the most
current received date record.
' No user confirmation is required.
Dim rst As DAO.Recordset
Dim rst2 As DAO.Recordset
Dim tdf As DAO.TableDef
Dim fld As DAO.Field
Dim strSQL As String
Dim varBookmark As Variant
strTableName = "tlbtest1"
Set tdf = DBEngine(0)(0).TableDefs(strTableName)
strSQL = "SELECT tlbtest1.[num], tlbtest1.[Rcvddate]" _
& "FROM tlbtest1 " _
& "ORDER BY tlbtest1.[num], tlbtest1.[RcvdDate] DESC;"

'Set tdf = Nothing
Debug.Print strSQL
Set rst = CurrentDb.OpenRecordset(strSQL)
Set rst2 = rst.Clone
rst.MoveNext
Do Until rst.EOF
varBookmark = rst.Bookmark
For Each fld In rst.Fields
If fld.Value <rst2.Fields(fld.Name).Value Then
GoTo NextRecord
End If
Next fld
rst.Delete
GoTo SkipBookmark
NextRecord:
rst2.Bookmark = varBookmark
SkipBookmark:
rst.MoveNext
Loop
End Sub

What determines if two records are 'duplicates'?
How do you deal with a set of 'matched' records where you have
multiple racords on the latest date?