Delete Duplicate records

[Theodore70]

I am trying to delete duplicate records in an access table using VB. Not a programmer here, but this was one of the codes that I found on the web. I made some modifications to it, but it still did not work for me.

Public Function DeleteDuplicate()
Dim db As DAO.Database
Dim qdf As QueryDef
Dim strSQL As String
Dim strEmail As String

dteEmail = DMax("[Email]", "tbl_email")

strSQL = "Delete * FROM tbl_email" & _
"WHERE (tbl_email.email)> strEmail"

Set db = CurrentDb
With db
Set qdf = .CreateQueryDef("tmpQuery", strSQL)
DoCmd.OpenQuery "tmpQuery"
.QueryDefs.Delete "tmpQuery"
End With
db.Close
qdf.Close
End Function

Any assistance is greatly appreciated.

[comteck]

Create a query based on the table that you are checking for duplicates from. Call the query "qryDuplicates" . Open the query in design view, and enter the following statement in the field that you are checking for duplicates (i.e if you are checking for duplicate serial numbers, and that field is called "serialnumber") , enter this statement in criteria under the field "serialnumb er":

In (SELECT [serialnumber] FROM [tablename] As Tmp GROUP BY [serialnumber] HAVING Count(*)>1 )

After doing that, create an APPEND query, and base it on the qryDuplicates query. When you run the APPEND query, it should delete all the duplicates in that table.

Hope this helps.
comteck

[Killer42]

I don't get it. How can this delete anything? Won't it just append to somewhere the complete list of records which have duplicate serial numbers?

[MMcCarthy]

dteEmail = DMax("[Email]", "tbl_email" )

should be

strEmail = DMax("[Email]", "tbl_email" )

db.Close ' never close the database just set it to nothing and close the query first. i.e.

qdf.Close
Set qdf = Nothing
Set db = Nothing

[Theodore70]

Apologies. I wasn't not clear on my original post.

I would like to delete duplicate records (email field), but keep at least one record. I have revised the script based on the replies that I have recieved, but I am still not able to get the script to run correctly.

Any help is appreciated.

Thanks.

[MMcCarthy]

What is the value in email field. As you are using DMax I assume it's a number or date. Can you confirm?

If it's a date, are you just trying to create a list of emails by the last date sent by deleting all other emails.
Otherwise what is the criteria?

Apologies. I wasn't not clear on my original post.

I would like to delete duplicate records (email field), but keep at least one record. I have revised the script based on the replies that I have recieved, but I am still not able to get the script to run correctly.

Any help is appreciated.

Thanks.

[Theodore70]

The values of DMax are alphanumeric.

I am trying to delete duplicated (SMTP - email) since it is my only unique identifier available. It is a text field.

Thanks.

<What is the value in email field. As you are using DMax I assume it's a number or date. Can you confirm?

If it's a date, are you just trying to create a list of emails by the last date sent by deleting all other emails.
Otherwise what is the criteria>

[comteck]

I don't get it. How can this delete anything? Won't it just append to somewhere the complete list of records which have duplicate serial numbers?

Sorry Killer.... it did work for me. Might be a different case here. However, not everybody is correct in their solutions that they offer on here. Normally however, people are not rude about it.

[MMcCarthy]

DMax gets the Maximum Value you can't do that with an AlphaNumeric field.

BACKUP the table first!!

Try the following. First add a field to the table called temp with a true/false datatype. You can delete it later.

 
Public Function DeleteDuplicate()
Dim db As DAO.Database
Dim rs As RecordSet
Dim strEmail As String

Set db = CurrentDb
Set rs = db.OpenRecordset("tbl_email")

StartFile:
 
rs.MoveFirst
Do Until rs!temp = False
  If not rs.EOF then
	rs.MoveNext
  Else
	GoTo EndFile
  End If
Loop
 
strEmail = rs!email
rs!temp = True
rs.MoveNext
 
Do Until rs.EOF
  If rs!email = strEmail Then
	rs.Delete
  End If
  rs.MoveNext
Loop
 
GoTo StartFile
 
EndFile:

rs.close
set rs = Nothing
set db = Nothing

End Function

[NeoPa]

M McCarthy - how can you do this to me?
I was working on a little routine for this thread when you posted a perfectly good answer.
Not cool ;-)

Anyway, as I've done it I might as well include it here.

This code does assume a table in the local db but it can be tweaked or enhanced.
For instance, if the one to be kept must have the lowest Primary Key value then it could be changed to do that.

'DelDups Removes duplicate records in strTable matched on strField
Public Sub DelDups(strTable As String, strField As String)
    Dim strSQL As String, varLastVal As Variant

    'Recordset must be full table but sorted by the field we're checking
    strSQL = "SELECT * FROM [" & strTable & "] ORDER BY [" & strField & "]"
    With CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
        varLastVal = Null
        'For each record, check against previous value in strField
        'If same then this is a duplicate so can be removed
        Do Until .EOF
            If .Fields(strField) = varLastVal Then
                Call .Delete
            Else
                varLastVal = .Fields(strField)
            End If
            Call .MoveNext
        Loop
    'Ending the 'With' releases the Recordset
    End With
End Sub

Hope it helps.

[MMcCarthy]

Hi NeoPa

I hate it when that happens. You get all excited when you get it working then post it to find someone got in before you. Happens to me all the time.

Mary

[Killer42]

Sorry Killer.... it did work for me. Might be a different case here. However, not everybody is correct in their solutions that they offer on here. Normally however, people are not rude about it.

Apologies if I sounded a bit rude - it wasn't intended that way.

[Zeeshan7]

hi,

Step 1: Use make a table query and name it e.g. new table
Step 2: Delete all records of this new table (as it contains all records)
Step 3: After deletion of records, set primary key in new table
Step 4: Now use append query. You will see that only unique records will be appended in new table. Good luck

[Theodore70]

MMcCarthy,

Sorry I haven't responded sooner.

Your coding works like a charm. I appreciate everyone's assistance.

Thanks!

[martinmike2]

MMcCarthy,

Sorry I haven't responded sooner.

Your coding works like a charm. I appreciate everyone's assistance.

Thanks!

Hmm.... this code dosn't seem to work for me. I have added a temp field to my table to try this out, but when i try to run it i get "Update or CancelUpdate without AddNew or Edit" the error pops up on rst!temp = true.