Delete Duplicates with VBA

[slenish]

Hello,

I am trying to write a code that will look through a table for duplicates and delete them. I currently have a code I found on an older post in bytes that works fine for deleting duplicates but I am trying to figure out a way i can modify it to delete duplicates based on a criteria.

I have been trying to change it so that if I have strField(1) that is Not Null and another strField(2) that Is Null and strField(1) is a duplicate then delete it.

Any help would be appreciated.

Thanks,

Slen

below is the code i am working with (orginally posted by NeoPa)

'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 
 
 

[Rabbit]

Why do it through VBA instead of a delete query?

[slenish]

Mostly because I have code built that is doing a few other things to the table before and after finding the duplicates.

I was trying to avoid the whole dup/append queries and then pull that information back in to the main table.

slen :D

[Rabbit]

Well, then you pretty much translate what you said into VBA code

If Not IsNull(.Fields(strField1) And IsNull(.Fields(strField2) Then

[slenish]

Thanks Rabbit,

That was what I needed!

I am still finding that it is not quite deleting all the duplicates which I think its because there might be some that could be triplicates.

I will continue to play with it and see if i can figure it out. I apprecaite the help in getting me in the right direction.

Thanks again,

Slen :D

[ADezii]

The following Demo, hard coded for the sake of simplicity, will Delete any Duplicates, Triplicates, etc. where Duplication is defined as [Field1] NOT being NULL and [Field2] Is NULL. I also posted sample Before and after Data.

Dim MyDB As DAO.Database
Dim rst As DAO.Recordset
 
Set MyDB = CurrentDb
Set rst = MyDB.OpenRecordset("Table1", dbOpenDynaset)
 
With rst
  Do While Not .EOF
    If Not IsNull(![Field1]) And IsNull(![Field2]) Then     'Check for Duplication
      If DCount("*", "Table1", "[Field1] = '" & ![Field1] & "' AND [Field2] Is Null") > 1 Then
        .Delete
      End If
    End If
      .MoveNext
  Loop
End With
 
rst.Close
Set rst = Nothing

Before Executing Code:

PK  Field1  Field2
1     A       1
2     B
3     C
4     D       4
5     E       5
6     f       6
7     G       7
8     H       8
9     B
10    C
11    E
12    f
13    G
14    t      44
15    M
16    B
17    B
18    C
19    D
20    p

After Code Execution:

PK  Field1  Field2
1     A       1
4     D       4
5     E       5
6     f       6
7     G       7
8     H       8
11    E
12    f
13    G
14    t      44
15    M
17    B
18    C
19    D
20    p

P.S. - Records with Primary Key Values of 2, 3, 9, 10, and 16 have been Deleted.

[slenish]

Hi ADezii,

Once again you skills are the stuff of legend. That worked a lot better. Now I just have to figure out how i can change it some to go in to a function :D

Really appreciate your help!

Is there anyway i can change your response to the correct answer?

Slen

[slenish]

An add on question for you,

How would i modify this to check for duplicates and then if there is one value in the duplicate that is different to delete it?

I tried something like this but i keep getting errors...

Dim MyDB As DAO.Database
Dim rst As DAO.Recordset
 
Set MyDB = CurrentDb
Set rst = MyDB.OpenRecordset("tbl", dbOpenDynaset)
 
With rst
  Do While Not .EOF
     If Not IsNull(![strField1]) And IsNull(![strField2]) Then     'Check for Duplication
      If DCount("*", "tbl", "[strField1] = '" & ![strField1] & "' AND [strField2] Is Null") > 1 And _
        DLookup("*", "tbl", "[Code1]= 'No Error'") Then
         .Delete
      End If
     'End If
    End If
      .MoveNext
  Loop
End With
 
rst.Close
Set rst = Nothing
 

[ADezii]

if there is one value in the duplicate that is different to delete it?

Kindly explain, not sure what you mean...

[slenish]

Going off of the code you did if I wanted to make adjustments to it so if I have a duplicate record the identifier would be strField1 (an ID #), in strField2 one record is Null and the other is Not Null and in a strField3 I could have two different values, for example code1 and code2. If I wanted to delete only the record where strField1 is a duplicate, strField2 is Null and strField3 = code2, how could I adjust this??

I can get this to run but it is not deleting anything...any ideas?

With rst
  Do While Not .EOF
     If Not IsNull(![ID]) And IsNull(![Amt]) Then    'Check for Duplication
      If DCount("*", "tblName", "[ID] = '" & ![ID] & "' >1 And [Amt] Is Null And [ErrCode] = '" & strText & "'") Then
         .Delete
      End If
     'End If
    End If
      .MoveNext
  Loop
End With
 
rst.Close
Set rst = Nothing
 

[ADezii]

Try:

Dim MyDB As DAO.Database
Dim rst As DAO.Recordset
Dim strCode As String
 
strCode = "YaDa"
 
Set MyDB = CurrentDb
Set rst = MyDB.OpenRecordset("Table1", dbOpenDynaset)
 
With rst
  Do While Not .EOF
    If Not IsNull(![Field1]) And IsNull(![Field2]) Then     'Check for Duplication
      If DCount("*", "Table1", "[Field1] = '" & ![Field1] & "' AND [Field2] Is Null AND " & _
         "[ErrCode] = '" & strCode & "'") > 1 Then
        .Delete
      End If
    End If
      .MoveNext
  Loop
End With
 
rst.Close
Set rst = Nothing

[slenish]

Hi ADezii,

Apprecaite your continued help with this.

I tried your revision but it did not work. I made a small adjustment where I took out the >1 and for some reason that worked...any idea why?

Dim MyDB As DAO.Database 
Dim rst As DAO.Recordset 
Dim strCode As String 
 
strCode = "YaDa" 
 
Set MyDB = CurrentDb 
Set rst = MyDB.OpenRecordset("Table1", dbOpenDynaset) 
 
With rst 
  Do While Not .EOF 
    If Not IsNull(![Field1]) And IsNull(![Field2]) Then     'Check for Duplication 
      If DCount("*", "Table1", "[Field1] = '" & ![Field1] & "' AND [Field2] Is Null AND " & _ 
         "[ErrCode] = '" & strCode & "'")  Then 
        .Delete 
      End If 
    End If 
      .MoveNext 
  Loop 
End With 
 

rst.Close
Set rst = Nothing