Brook,
I had some code awhile back that did something like this. This does not
require the delete duplicates query wizard, nor does it require you to write
the query that determines which records are duplicates. All you have to do
is pass this subroutine the name of the table to be checked, and the fields
which you want to use to define duplicates. It selects all of the fields
from the table into a recordset sorted by the fields you list, then works
its way through the recordset and deletes records when they are the same as
the previous record. To delete duplicates from an employees table which
contains [First_Name], [Last_Name], and [SSN] fields, you would simply call
it by:
Call DeleteDuplicates("tbl_employees", "First_Name", "Last_Name", "SSN")
HTH
Dale
Public Sub DeleteDuplicates(TableName As String, ParamArray DupFields())
'Deletes duplicates from a recordset (table or query) base on the values
in the fields provided
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim DupValues() As Variant
ReDim DupValues(UBound(DupFields))
Dim bDuplicateRecord As Boolean
Dim intLoop As Integer
Dim strSQL As String, varOrder As Variant
Set db = CodeDb
'Build the SQL string to select the records ordered by the
'fields provided
strSQL = "SELECT * FROM [" & TableName & "] "
varOrder = Null
For intLoop = LBound(DupFields) To UBound(DupFields)
varOrder = (varOrder + ", ") & "[" & DupFields(intLoop) & "]"
Next
strSQL = strSQL & ("ORDER BY " + varOrder)
Debug.Print strSQL
Set rs = db.OpenRecordset(strSQL)
While Not rs.EOF
bDuplicateRecord = True
'Determine whether the current record is a duplicate of the
'previous record based on the fields provided
For intLoop = LBound(DupFields) To UBound(DupFields)
If IsNull(rs(DupFields(intLoop))) And Not
IsNull(DupValues(intLoop)) Then
bDuplicateRecord = False
Exit For
ElseIf IsNull(DupValues(intLoop)) And Not
IsNull(rs(DupFields(intLoop))) Then
bDuplicateRecord = False
Exit For
ElseIf DupValues(intLoop) <> rs(DupFields(intLoop)) Then
bDuplicateRecord = False
Exit For
End If
Next
'If a duplicate delete the record
'Otherwise, fill the DupValues array with the value of the
'fields provided
If bDuplicateRecord Then
With rs
rs.Delete
End With
Else
For intLoop = LBound(DupFields) To UBound(DupFields)
DupValues(intLoop) = rs(DupFields(intLoop))
Next
End If
rs.MoveNext
Wend
rs.Close
Set rs = Nothing
db.Close
Set db = Nothing
End Sub
