Solved

Delete Selected Duplicate Records from a Linked Table Recordset - VBA

Posted on 2013-11-18
6
732 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
Enterprise Mobility and BYOD For Dummies

Like “For Dummies” books, you can read this in whatever order you choose and learn about mobility and BYOD; and how to put a competitive mobile infrastructure in place. Developed for SMBs and large enterprises alike, you will find helpful use cases, planning, and implementation.

 

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

U.S. Department of Agriculture and Acronis Access

With the new era of mobile computing, smartphones and tablets, wireless communications and cloud services, the USDA sought to take advantage of a mobilized workforce and the blurring lines between personal and corporate computing resources.

Question has a verified solution.

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

Many companies are making the switch from Microsoft to Google Apps (https://www.google.com/work/apps/business/). Use this article to learn more about what Google Apps has to offer and to help if you’re planning on migrating to Google Apps. It is …
This collection of functions covers all the normal rounding methods of just about any numeric value.
Basics of query design. Shows you how to construct a simple query by adding tables, perform joins, defining output columns, perform sorting, and apply criteria.
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…

810 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