Solved Delete specific rows using vba (1 Viewer)

[lucky245]

I have a table with duplicate records but also semi duplicate records.

SpNo SpDate DateAuth Result CulComment
B1445677 15/06/2020 26/06/2020 NO res myo comm
B1445677 15/06/2020 26/06/2020 -------- myo comm
B1445677 15/06/2020 23/06/2020 -------- myo comm

What I'm trying to do is delete from the table the 3rd (oldest) and second record leaving the first only (The system is old and kicks out both the ------ and then the No Res. the "--------" is always the same length the No Res can say anything etc

The table has 1000's of records

I can scroll though and look for pure duplicate and delete them easily but problem I'm having is the task with the records as above.

Sub DeleteDupRec(Tablename As String)

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

Set tdf = DBEngine(0)(0).TableDefs(strTableName)
strSQL = "SELECT * FROM " & strTableName & " ORDER BY "

For Each fld In tdf.Fields
If (fld.Type <> dbMemo) And (fld.Type <> dbLongBinary) Then
strSQL = strSQL & fld.Name & ", "
End If
Next fld

strSQL = Left(strSQL, Len(strSQL) - 2)
Set tdf = Nothing

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 stopmk
NextRecord:
rst2.Bookmark = varBookmark


stopmk:
rst.MoveNext
Loop


End Sub

 

[arnelgp]

add an Autonumber field to your table then
you can delete using Query:

DELETE *
FROM Table1
WHERE ID <> (SELECT Min(ID) AS MinOfID FROM Table1 AS Dupe
WHERE (Dupe.SpNo = Table1.SpNo)
AND (Dupe.SpDate = Table1.SpDate)
AND (Dupe.Result Not Like "-*"));

 

[lucky245]

Thank you, went a slightly different way but the Sql and the Autonumber hint was essential for my brain to kick in

Sub RemoveTBDuplicates(strTablename As String)
Dim db As Database
Dim rst, rst2 As Recordset

Set db = CurrentDb
Set rst = db.OpenRecordset(strTablename)
Set rst2 = db.OpenRecordset("Dupe")

rst2.MoveFirst
rst.MoveFirst
Do Until rst2.EOF

If rst2.Fields(5).Value = "----------" Then

Do Until rst.EOF
If rst2.Fields(0) = rst.Fields(0) Then
rst.Delete
rst.MoveNext
Exit Do
End If
rst.MoveNext
Loop
End If
rst2.MoveNext
Loop


rst.Close
rst2.Close
db.Close

End Sub

 

[arnelgp]

try this one:

Sub RemoveDupesFromSP(ByVal TableName As String)
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim sCriteria As String
On Error GoTo err_handler
    If Left$(TableName, 1) <> "[" Then
        TableName = "[" & TableName
    End If
    If Right$(TableName, 1) <> "]" Then
        TableName = TableName & "]"
    End If
    Set db = CurrentDb
    Set rs = db.OpenRecordset( _
                "select " & TableName & ".* from " & TableName & " " & _
                "order by [spNo], [spDate], " & _
                "Iif([Result] Like '-*', 9, 1);", dbOpenDynaset)
    With rs
        If Not (.BOF And .EOF) Then
            .MoveFirst
        End If
        Do Until .EOF
            sCriteria = ![SpNo] & "/" & Format$(![SpDate], "yyyy-mm-dd")
            Do While ![SpNo] & "/" & Format$(![SpDate], "yyyy-mm-dd") = sCriteria
                If ![Result] & "" Like "-*" Then
                    .Delete
                End If
                .MoveNext
                If .EOF Then
                    Exit Do
                End If
            Loop
        Loop
        .Close
    End With
    
exit_point:
    Set rs = Nothing
    Set db = Nothing
    Exit Sub
err_handler:
    MsgBox Err.Number & ": " & Err.Description
    Resume exit_point
End Sub

 

[lucky245]

A lot easier to understand and more efficient it seems. Thank you