Solved

Delete Selected Duplicate Records from a Linked Table Recordset - VBA

Posted on 2013-11-18
6
728 Views
Last Modified: 2013-12-09
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
Comment
Question by:skennelly
  • 4
  • 2
6 Comments
 
LVL 49

Expert Comment

by:Gustav Brock
ID: 39657205
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
 

Author Comment

by:skennelly
ID: 39659403
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
 
LVL 49

Expert Comment

by:Gustav Brock
ID: 39659531
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
Complete VMware vSphere® ESX(i) & Hyper-V Backup

Capture your entire system, including the host, with patented disk imaging integrated with VMware VADP / Microsoft VSS and RCT. RTOs is as low as 15 seconds with Acronis Active Restore™. You can enjoy unlimited P2V/V2V migrations from any source (even from a different hypervisor)

 

Author Comment

by:skennelly
ID: 39664878
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
 

Accepted Solution

by:
skennelly earned 0 total points
ID: 39696862
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
 

Author Closing Comment

by:skennelly
ID: 39705720
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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Overview: This article:       (a) explains one principle method to cross-reference invoice items in Quickbooks®       (b) explores the reasons one might need to cross-reference invoice items       (c) provides a sample process for creating a M…
As with any other System Center product, the installation for the Authoring Tool can be quite a pain sometimes. This article serves to help you avoid making these mistakes and hopefully save you a ton of time on troubleshooting :)  Step 1: Make sur…
With Microsoft Access, learn how to start a database in different ways and produce different start-up actions allowing you to use a single database to perform multiple tasks. Specify a start-up form through options: Specify an Autoexec macro: Us…
The viewer will learn how to simulate a series of sales calls dependent on a single skill level and learn how to simulate a series of sales calls dependent on two skill levels. Simulating Independent Sales Calls: Enter .75 into cell C2 – “skill leve…

911 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

19 Experts available now in Live!

Get 1:1 Help Now