By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
424,986 Members | 1,944 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 424,986 IT Pros & Developers. It's quick & easy.

please help - think this code needs a slight tweak

P: 14
Im using the following code to duplicate a record varCnt(retrieved from a combo box on the form) many times, and it only duplicates the record with the fields present on the form for that record.
The duplicate fields are [childs name] and [target 1] [target 2] (upto target 5) and then it duplicates the [weekly index] but adds 1 to each duplicate for this field.
But if the targets are updated again it keeps the old duplicates for future weeks, causing there to be 2 sets of records for those future weeks.
So ive added a bit to the code when they are added to search for duplicates, but what it does is delete all but the last updated record.
But what i need it to do is not to delete the last updated record, but the last varCnt record, so in other words if varCnt is 3, then it deletes all but the last 3.
heres the code, i reckon this must be quite simple, but i cant work it out, ive tried playing around a bit, but im not a coder:
Expand|Select|Wrap|Line Numbers
  1. Private Sub Command16_Click()
  2. On Error GoTo Err_Command16_Click
  3. Dim i As Integer, cnt As Integer, varBk As String
  4. Dim intCriteriaCount As Integer, MyDB As Database, MyRS As Recordset
  5. Dim intCounter As Integer
  6.  
  7. varBk = Me.Bookmark
  8. cnt = Me!Combo17
  9.  
  10. For i = 0 To cnt - 1
  11. DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70
  12. DoCmd.DoMenuItem acFormBar, acEditMenu, 2, , acMenuVer70
  13. DoCmd.DoMenuItem acFormBar, acEditMenu, 5, , acMenuVer70 'Paste Append
  14.  
  15. Me!Text22 = Me!Text22 + 1
  16.  
  17. Next
  18.  
  19. Exit_Command16_Click:
  20. Me.Bookmark = varBk
  21.  
  22. intCriteriaCount = DCount("*", "FindDuplicatesWeeklyPoints")
  23.  
  24. 'Are there Records meeting the Criteria?
  25. If intCriteriaCount > 0 Then
  26.   Set MyDB = CurrentDb()
  27.   'Order by your Primary Key Ascending
  28.   Set MyRS = MyDB.OpenRecordset("SELECT * FROM  FindDuplicatesWeeklyPoints ORDER BY [Weekly Index]")
  29.   MyRS.MoveLast: MyRS.MoveFirst
  30.     For intCounter = 1 To intCriteriaCount - 1      'All but the Last Record
  31.       MyRS.Delete
  32.       MyRS.MoveNext
  33.     Next
  34. Else
  35.   Exit Sub
  36. End If
  37.  
  38. MyRS.Close
  39.  
  40. Exit Sub
  41.  
  42. Err_Command16_Click:
  43. MsgBox Err.Description
  44.  
  45. Resume Exit_Command16_Click
  46.  
  47. End Sub
  48.  

thanks
Adam
Mar 18 '07 #1
Share this Question
Share on Google+
1 Reply


MMcCarthy
Expert Mod 10K+
P: 14,534
Hi Adam,

Will this work ...
Expand|Select|Wrap|Line Numbers
  1. Private Sub Command16_Click()
  2. On Error GoTo Err_Command16_Click
  3. Dim i As Integer, cnt As Integer
  4. Dim varBk As String
  5. Dim intCriteriaCount As Integer
  6. Dim MyDB As Database
  7. Dim MyRS As Recordset
  8. Dim intCounter As Integer
  9.  
  10. varBk = Me.Bookmark
  11. cnt = Me!Combo17
  12.  
  13. For i = 0 To cnt - 1
  14.    DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70
  15.    DoCmd.DoMenuItem acFormBar, acEditMenu, 2, , acMenuVer70
  16.    DoCmd.DoMenuItem acFormBar, acEditMenu, 5, , acMenuVer70 
  17.  
  18.    'Paste Append
  19.    Me!Text22 = Me!Text22 + 1
  20.  
  21. Next
  22.  
  23. Exit_Command16_Click:
  24. Me.Bookmark = varBk
  25.  
  26. intCriteriaCount = DCount("*", "FindDuplicatesWeeklyPoints")
  27.  
  28. 'Are there Records meeting the Criteria?
  29. If intCriteriaCount > 0 Then
  30.    Set MyDB = CurrentDb()
  31.    'Order by your Primary Key Ascending
  32.    Set MyRS = MyDB.OpenRecordset("SELECT * FROM FindDuplicatesWeeklyPoints ORDER BY [Weekly Index]")
  33.    MyRS.MoveLast: MyRS.MoveFirst
  34.    For intCounter = 1 To intCriteriaCount - cnt      'All but the Last Record
  35.       MyRS.Delete
  36.       MyRS.MoveNext
  37.    Next
  38. Else
  39.    Exit Sub
  40. End If
  41.  
  42. MyRS.Close
  43.  
  44. Exit Sub
  45.  
  46. Err_Command16_Click:
  47. MsgBox Err.Description
  48.  
  49. Resume Exit_Command16_Click
  50.  
  51. End Sub
  52.  
Mar 22 '07 #2

Post your reply

Sign in to post your reply or Sign up for a free account.