[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 757
  • Last Modified:

Delete Selected Duplicate Records from a Linked Table Recordset - VBA

I developed a database where I import Test Results records from a spreadsheet into a Test_Results table. Upon import the user may add additional test variables (test site, test comments, etc.)  through a linked common field into a Test_Demographics table. Due to company restrictions, these additional variables must be kept in a separate table.

The test results are imported via date range that the user selects. At times, the dates overlap from a previous import, and duplicate records are created in the Test_Results table. I developed code to delete the duplicate records records through a string variable as posted below. However, if the test results record contains linked data from the Test_Demographic table, I need to keep that particular record, and delete the rest of the duplicates. The current string variable does not recognize the identifier of the record I am attempting to preserve so I need to develop a procedure that identifies the record with the linked information, and delete the rest of the duplicates from the Test_Results download. Thanks, and I appreciate the assistance.

Private Sub cmdRemoveDuplicateTests_Click()
On Error Resume Next

  Dim db As DAO.Database, rst As DAO.Recordset
  Dim strDupName As String, strSaveName As String
 
  Set db = CurrentDb()
  Set rst = db.OpenRecordset("qryTestForDuplicates")
 
  If rst.BOF And rst.EOF Then
    DisplayMessage ("There are no entries.")
  Else
    rst.MoveFirst
    Do Until rst.EOF
      strDupName = rst.Fields(0) & rst.Fields(1) & rst.Fields(2) & rst.Fields(3) & rst.Fields(4)      
      If strDupName = strSaveName Then
        rst.Delete
      Else
        strSaveName = rst.Fields(0) & rst.Fields(1) & rst.Fields(2) & rst.Fields(3) & rst.Fields(4) & rst.Fields(5) & rst.Fields(6)  
      End If
      rst.MoveNext
    Loop
   
    Set rst = Nothing
    Set db = Nothing
  End If
    DisplayMessage ("All duplicate test entries have been deleted.")
End Sub
0
skennelly
Asked:
skennelly
  • 4
  • 2
1 Solution
 
Gustav BrockCIOCommented:
You may need a clone of the recordset:

Set db = CurrentDb()
Set rst = db.OpenRecordset("qryTestForDuplicates")
Set rstClone = rst.Clone

Then you can loop through rstClone and look up each record in rst and delete if found more than once.

/gustav
0
 
skennellyAuthor Commented:
I am able to create the rstClone and loop through the records but am having trouble "looking up" each record in rst and deleting it. The rst contains the linked Test_Result and Test_Demographics tables.

Perhaps I can loop through a recordset that contains only the Test_Demographics values to look up the value of the common TestID field, then take that value and loop through the Test_Results records using the FindFirst method to find the value of the TestID field in the Test_Results table. If the value is found, the record is skipped. If it is not the record is compared for deletion as in my first post. Just a thought, but I am having difficulty writing the correct code. Any suggestions will be helpful. Thanks.
0
 
Gustav BrockCIOCommented:
I thought of using FindFirst on rst. This should, of course, never fail, or rather:

rst.NoMatch will always be False.

But then use FindNext in a new loop. If NoMatch is False, a dupe is found. Delete this and loop until NoMatch = True.

/gustav
0
Efficient way to get backups off site to Azure

This user guide provides instructions on how to deploy and configure both a StoneFly Scale Out NAS Enterprise Cloud Drive virtual machine and Veeam Cloud Connect in the Microsoft Azure Cloud.

 
skennellyAuthor Commented:
The following code eliminates all but one duplicate record in Test_Results because the code does not recognize it as a duplicate due to the attached record in the Test_Demographic table. I need to be able to remove the duplicate in the Test Results table. Any suggestions? Thanks.

Set db = CurrentDb
Set rstTest = db.OpenRecordset("qryTestForDuplicates", dbOpenDynaset)
Set rstDemo = db.OpenRecordset("qryTestForDuplicatesDemo", dbOpenDynaset)
TestString = "[TestID] = " & rstTest![TestID]
   
If rstDemo.BOF And rstDemo.EOF Then
    DisplayMessage ("There are no entries.")
End If

If rstTest.BOF And rstTest.EOF Then
    DisplayMessage ("There are no entries.")
End If
   
rstTest.MoveFirst
Do Until rstTest.EOF
    TestString = rstTest![TestID]
    ' Look up the value list
        rstDemo.MoveFirst
        rstDemo.FindFirst ("TestDemoID = " & TestString)
    
    If rstDemo.NoMatch Then
        strDupName = rstTest![AthleteID] & rstTest![Reported] & rstTest![Collected] & rstTest![Received] & rstTest![SampleResult] & rstTest![Compound] & rstTest![HSN] _
        & rstTest![TestCode] & rstTest![TestDescription] & rstTest![TestResult] & rstTest![Threshold] & rstTest![Qty] & rstTest![Normalized] & rstTest![Value]
        
        If strDupName = strSaveName Then
            rstTest.Delete
        Else
            strSaveName = rstTest![AthleteID] & rstTest![Reported] & rstTest![Collected] & rstTest![Received] & rstTest![SampleResult] & rstTest![Compound] & rstTest![HSN] _
            & rstTest![TestCode] & rstTest![TestDescription] & rstTest![TestResult] & rstTest![Threshold] & rstTest![Qty] & rstTest![Normalized] & rstTest![Value]
        End If
    End If
    rstTest.MoveNext
Loop

End Sub

Open in new window

0
 
skennellyAuthor Commented:
After many hours, this is how I solved it.

Set db = CurrentDb
Set rstTest = db.OpenRecordset("qryTestForDuplicates", dbOpenDynaset)
Set rstDemo = db.OpenRecordset("qryTestForDuplicatesDemo", dbOpenDynaset)
TestString = "[TestID] = " & rstTest![TestID]
   
If rstDemo.BOF And rstDemo.EOF Then
    DisplayMessage ("There are no entries.")
End If

If rstTest.BOF And rstTest.EOF Then
    DisplayMessage ("There are no entries.")
End If

Beep
blnOK = ConfirmYesNo("By selecting Yes all duplicate drug tests will be deleted. Tests containing additional Test Parameters must be deleted manually. Do you wish to proceed?")
If blnOK Then

rstTest.MoveFirst
Do Until rstTest.EOF
    TestString = rstTest![TestID]
    ' Look up the value list
        rstDemo.MoveFirst
        rstDemo.FindFirst ("TestDemoID = " & TestString)
    
    If rstDemo.NoMatch Then
        strDupName = rstTest![AthleteID] & rstTest![Reported] & rstTest![Collected] & rstTest![Received] & rstTest![SampleResult] & rstTest![Compound] & rstTest![HSN] _
        & rstTest![TestCode] & rstTest![TestDescription] & rstTest![TestResult] & rstTest![Threshold] & rstTest![Qty] & rstTest![Normalized] & rstTest![Value] _
        & rstTest![Medical] & rstTest![Reviewed] & rstTest![FollowUpTest] & rstTest![TestComments]
        If strDupName = strSaveName Or strDupName = strMatchName Then
            rstTest.Delete
        Else
            strSaveName = rstTest![AthleteID] & rstTest![Reported] & rstTest![Collected] & rstTest![Received] & rstTest![SampleResult] & rstTest![Compound] & rstTest![HSN] _
            & rstTest![TestCode] & rstTest![TestDescription] & rstTest![TestResult] & rstTest![Threshold] & rstTest![Qty] & rstTest![Normalized] & rstTest![Value] _
            & rstTest![Medical] & rstTest![Reviewed] & rstTest![FollowUpTest] & rstTest![TestComments]
        End If
    Else
        strMatchName = rstTest![AthleteID] & rstTest![Reported] & rstTest![Collected] & rstTest![Received] & rstTest![SampleResult] & rstTest![Compound] & rstTest![HSN] _
            & rstTest![TestCode] & rstTest![TestDescription] & rstTest![TestResult] & rstTest![Threshold] & rstTest![Qty] & rstTest![Normalized] & rstTest![Value] _
            & rstTest![Medical] & rstTest![Reviewed] & rstTest![FollowUpTest] & rstTest![TestComments]
        If Not rstTest.BOF Then
            rstTest.MovePrevious
            TestString = rstTest![TestID]
            rstDemo.MoveFirst
            rstDemo.FindFirst ("TestDemoID = " & TestString)
                If rstDemo.NoMatch Then
                strDupName = rstTest![AthleteID] & rstTest![Reported] & rstTest![Collected] & rstTest![Received] & rstTest![SampleResult] & rstTest![Compound] & rstTest![HSN] _
                & rstTest![TestCode] & rstTest![TestDescription] & rstTest![TestResult] & rstTest![Threshold] & rstTest![Qty] & rstTest![Normalized] & rstTest![Value] _
                & rstTest![Medical] & rstTest![Reviewed] & rstTest![FollowUpTest] & rstTest![TestComments]
                    If strDupName = strMatchName Or strDupName = strSaveName Then
                        rstTest.Delete
                        rstTest.MoveNext
                    End If
            Else
                    rstTest.MoveNext
            End If
        End If
     End If
    rstTest.MoveNext
Loop
    DisplayMessage ("All duplicate entries have been deleted.")

Open in new window

0
 
skennellyAuthor Commented:
I worked through the solution myself. I was glad to have someone comment/assist but it did not help with the solution. Thanks.
0

Featured Post

Prep for the ITIL® Foundation Certification Exam

December’s Course of the Month is now available! Enroll to learn ITIL® Foundation best practices for delivering IT services effectively and efficiently.

  • 4
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now