Access 2003 Dupe command in VBA or use of Control + D keys causes records to be overwritten instead of copied to a new record

Good evening,

 I am working in our public agency's Microsoft Access database which has undergone many conversions over time (MS Access 2000, 2003, 2007 and now 2013). Every now and then I run into an old command program that seems to no longer work in my Access 2013 on my new Windows 10 OS. I discovered such an issue this week, but I am not an advanced programmer. Prior to Windows 10 OS, I was able to use "Control + D" or a Dupe Command button on right-click to duplicate an entire record to a new record with a new project ID number. The Project ID field is my key field. Now, when I use either of these, the record duplicates, but overwrites the last record in the database instead of duping to a blank record and creating a new Project ID, leaving the old record's Project ID number. I have spent days trying to figure out in the VBA what is happening. I know there are a few command changes necessary, but I have not had to program in a while. I located this in the programming background which I am not sure is Access 2013 language.

 Case "acCmdDuplicate"
 DoCmd.RunCommand acCmdDuplicate

 I located the following codes associated with the Dupe or Duplicate record command in several of my forms.

Private Sub cmdDUPE_Click()
Dim Response
Response = MsgBox("A duplicate of the current record will be created.  Do you want to continue?", 36)
    If Response = vbYes Then GoTo GenDupe
Exit Sub
DoCmd.SetWarnings True
'add refresh 5/13/03 - will this fix it?
Dim frst As Recordset
'set up a blank form
'copy data from the prior record to the new record
Set frst = Me.RecordsetClone
frst.FindFirst "[Fchem_ID] = " & Me![ipFchemID]
If frst.NoMatch Then
    MsgBox ("No match for number entered!")
    Exit Sub
End If
Me.AllowAdditions = True
Do Until Me.NewRecord
    SendKeys "{PGDN}", True
Me![ipPerID] = frst![Per_ID]
Me![ipFacID] = frst![Fac_ID#]
'the following statement may be a misnomer; replaced w. 2nd stmt:
'Me![ipPermARMS] = frst![ARMS#]
'Me![ipPermARMS] = frst![PermARMS]
'Populate the detail
'Me![ipEFactID] = frst![EFACT_ID]
Me![ipSCC_CODE] = frst![SCC_CODE]
Me![ipSearchCode] = frst![SCC_CODE]
Me![ipPolCode] = frst![POL_CODE]
Me![ipCASNumber] = frst![CASNUMBER]
Me![ipEmplNo] = frst![Empl_No]
Me![ipInvYr] = frst![Inv_Yr]
Me![ipEmissionType] = frst![Emission Type]
Me![ipSrcCat] = frst![Src_Cat]
'do we want Data_SRC?
'Me![ipDataSrc] = frst![DATA_SRC]
'Me![ipAQDsrc] = frst![AQD_src]
'do we want ProcessRate?
Me![ipProcessRate] = frst![ProcessRate]
'Me![ipProcessRatePrev] = frst![ProcessRate Prev]

'Me![ipEFAdjust] = frst![EFAdjust]
'Me![ipEFPrev] = frst![EF_Prev]
'Me![ipEFVAL] = frst![EFVAL]

'Added to Dupe to replace Chem_Cat - ME 4/9/03
'Me![ipDEPCode] = frst![DEP Code]
'Me![ipChemCat] = frst![Chem_Cat]

Me![HoursDay] = frst![HoursDay]
Me![DaysWeek] = frst![DaysWeek]
Me![ipHrsYear] = frst![HrsYear]
Me![DJF] = frst![DJF]
Me![MAM] = frst![MAM]
Me![JJA] = frst![JJA]
Me![SON] = frst![SON]
Me![ipO3hrsDay] = frst![O3hrsDay]
Me![ipO3DaysWk] = frst![O3DaysWk]
Me![ipO3days] = frst![O3days]
Me![ipO3ProcessRate] = frst![O3ProcessRate]

'Me![ipComments] = frst![Comments]
'Me![ipCommentsPrev] = frst![Comments Prev]
MsgBox ("This is a new record created by duplicating FAC_CHEM ID : " & Str(frst![Fchem_ID]))
Me.AllowAdditions = False
End Sub  

Open in new window

The second code, which is associated with the issue I discussed if this:

 Private Sub ipPerID_DblClick(Cancel As Integer)
'causes the creation of duplicate records
If IsNull(Me.Parent![fDupeFacID]) Then
    MsgBox ("FAC_CHEM records need to be selected for copying!")
    Exit Sub
End If
Dim Response
Dim CR
CR = Chr(13)
Response = MsgBox("Copy records?" & CR & "From:" & CR & "  FacID:" & Me.Parent![fDupeFacID] & CR & "  PerID:" & Me.Parent![fDupePerID] & CR & "  For:" & Me.Parent![fDupeInvYr] & CR & "To:" & CR & "  FacID:" & Me![ipFacID] & CR & "  PerID:" & Me![ipPerID], 36)
    If Response = vbYes Then GoTo OwnerDelete
    MsgBox ("Records will not be copied!")
    Exit Sub
DoCmd.SetWarnings False
DoCmd.OpenQuery "qAORCopy2"
DoCmd.SetWarnings True
Me.Parent![fDupeFacID] = Null
End Sub 

Open in new window

Option Compare Database
Option Explicit
Dim DeleteProjID As Long

Private Sub Form_AfterDelConfirm(Status As Integer)
If Status = 0 Then
    MsgBox ("Proj_ID " & Str(DeleteProjID) & " has been deleted.")
End If
End Sub

Private Sub Form_BeforeUpdate(Cancel As Integer)
'this routine validates the record
Dim Response As Integer
If IsNull([ipEmployeeNo]) Then
    MsgBox ("Missing employee information!")
End If
If IsNull([ipProjDesc]) Then
    MsgBox ("Missing Project Description!")
End If
If IsNull([ipProjtype]) Then
    MsgBox ("Missing Project Type!")
End If
If [ipProjtype] = "enf" And ([ipEmployeeNo] <> "1" And [ipEmployeeNo] <> "39358" And [ipEmployeeNo] <> "101855" And [ipEmployeeNo] <> "21392" And [ipEmployeeNo] <> "36126" And [ipEmployeeNo] <> "36638" And [ipEmployeeNo] <> "100803" And [ipEmployeeNo] <> "31108" And [ipEmployeeNo] <> "34626" And [ipEmployeeNo] <> "23116" And [ipEmployeeNo] <> "33176") And [ipEmployeeNo] <> "15304" And [ipEmployeeNo] <> "23116" And [ipEmployeeNo] <> "3930" And [ipEmployeeNo] <> "20998" And [ipEmployeeNo] <> "99999" And [ipEmployeeNo] Then
    MsgBox ("Employee must be All Project Example, Burchfield, Cox, Culliver, Farrington, Froberg, Hennis, Soptei, Martin, McCann, Crane, Brodeur, or Robbins for eft project type!")
End If
If [ipCompleteDate] > Now Then
    Response = MsgBox("The Complete Date is in the future.  Is that ok?", 36)
        If Response = vbYes Then GoTo CheckDueDate
End If
If [ipDueDate] > DateAdd("yyyy", 2, Now) Then
    Response = MsgBox("Due Date is more than 2 years in the future.  Is that ok?", 36)
        If Response = vbYes Then Exit Sub
End If
If ([ipProjtype] = "aorR" Or [ipProjtype] = "ccp" Or [ipProjtype] = "socr" Or [ipProjtype] = "trv" Or _
    [ipProjtype] = "trs" Or [ipProjtype] = "trs2" Or [ipProjtype] = "trs3") Then
    If (Not IsNull([ipCompleteDate])) Then
        If (IsNull([ipPerID]) Or [ipPerID] = 0) Then
        MsgBox ("Per_ID Must Be Entered for this Project!")
         'On Error Resume Next
        End If
   End If
End If

End Sub 

Private Sub Form_Current()
'primes link
On Error Resume Next
Me.Parent!FormLink1 = Me![ipProjID]
glbProjID = Me![ipProjID]
Me![CurrProjID] = Me![ipProjID]
End Sub 

Open in new window

and this code:

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
'If Me.CurrentRecord <> Me.ProjectCount Then
Call UPandDOWN3(KeyCode, Me.CurrentRecord, Me![ProjectCount])
'    GoTo ContKeyDown
'End If
'If KeyCode = vbKeyUp Then
'    SendKeys "^{PGUP}", True
'    Exit Sub
'End If
'If KeyCode = vbKeyDown Then
'    SendKeys "^{PGDN}", True
'    Exit Sub
'End If
'If KeyCode = vbKeyReturn Then
'    SendKeys "^{PGDN}", True
'    Exit Sub
'End If
If KeyCode = vbKeyAdd Then Exit Sub
If KeyCode = vbKeySubtract Then Exit Sub
'Insert key
If KeyCode = vbKeyInsert Then GoTo GoToNewRec
If Shift = acCtrlMask And KeyCode = vbKeyDown Then GoTo ChkCtrlDown
If Shift = acCtrlMask And KeyCode = 68 Then GoTo ChkCtrlDupe
If Shift = acCtrlMask And KeyCode = 100 Then GoTo ChkCtrlDupe
'F6 Key
If KeyCode = vbKeyF6 Then GoTo togl
If Shift = acCtrlMask And (KeyCode = 90 Or KeyCode = 122) Then
    Exit Sub
End If
Exit Sub
'takes focus to the fProjectMemo subform
KeyCode = 0
If IsNull(Me![ipProjID]) Then Exit Sub
'on a new record, this updates the linkage between this form
'and the memo subform
'it also primes a global variable with the new Proj_ID code
'which is used by the fProjectMemo and fProjMemoPopup queries
If Me.NewRecord = True Then
    Me.Parent!FormLink1 = Me![ipProjID]
    glbProjID = Me![ipProjID]
End If
'resets focus to fProjectMemo subform
Exit Sub
'duplicate the current record
If Me.NewRecord = True Then Exit Sub
'calls a procedure located in module GenMods that copies
'the record
Call DupeProjRecord
Exit Sub
'Inset key causes focus to go to new record
If Me.NewRecord = True Then Exit Sub
'this takes cursor to last active record
Dim rst As Recordset
Set rst = Me.RecordsetClone
Me.Bookmark = rst.Bookmark
'this takes focus down to the new record at the bottom
SendKeys "{PGDN}", True
Exit Sub
'this changes the focus to either of two forms....if they are open
KeyCode = 0
If (SysCmd(acSysCmdGetObjectState, A_FORM, "fAsbFac01") <> 0) Then
ElseIf (SysCmd(acSysCmdGetObjectState, A_FORM, "fFacDetail01") <> 0) Then
End If
End Sub 

Open in new window

 I have attached a snapshot of the form and the dupe on "right-click". Does anyone know what may need updating in my code I provided? Any assistance or guidance is very much appreciated. I have lost a few files to overwriting before I discovered this issue.
Tammy AllenAdministrative Project CoordinatorAsked:
Who is Participating?
Scott McDaniel (Microsoft Access MVP - EE MVE )Infotrakker SoftwareCommented:
Try replacing this block of code (from your first code block):

Do Until Me.NewRecord
    SendKeys "{PGDN}", True

With this:

DoCmd.RunCommand acCmdRecordsGoToNew
Tammy AllenAdministrative Project CoordinatorAuthor Commented:
I tried replacing the lines with the suggestion.  I made test project.  The last record is still overwritten.
Scott McDaniel (Microsoft Access MVP - EE MVE )Infotrakker SoftwareCommented:
You'd have to upload your project, I think.
Tammy AllenAdministrative Project CoordinatorAuthor Commented:

I found the true source of the problem.  I apologize.  Please disregard all the prior code.  The master code causing the overwriting in 2013 is the following code.  This appears to be still in 2003 code.  Would you know how to upgrade this to be read in 2013?

Public Function DupeProjRecord()
'called from shortcut menu pProjPopup - 'Dupe'
'called from [fProjectData]Form KeyDown event - if keycode is
'for Ctrl+D or Ctrl+d
Dim frm As Form
Set frm = Forms![fPREPROJECT]![fProjectData].Form
'if activated from new (unsaved) record do not continue
If frm.NewRecord Then Exit Function
'copy data from the record with focus into temporary Hold fields
Dim HoldEmployeeNo
Dim HoldProjType
Dim HoldProjDesc
Dim HoldTime
Dim HoldDueDate
Dim HoldCompleteDate
Dim HoldProg
Dim HoldMod
Dim HoldImprove
Dim HoldWorkPlan
Dim HoldWorkUnits
Dim HoldComment
HoldEmployeeNo = frm![ipEmployeeNo]
HoldProjType = frm![ipProjtype]
HoldProjDesc = frm![ipProjDesc]
HoldTime = frm![ipTime]
HoldDueDate = frm![ipDueDate]
HoldCompleteDate = frm![ipCompleteDate]
HoldProg = frm![ipProg#]
HoldMod = frm![ipMod#]
HoldImprove = frm![ipImprove]
HoldWorkPlan = frm![ipWorkplan]
HoldWorkUnits = frm![ipWorkUnits]
HoldComment = frm![ipComment]
'move to last record
Dim rst As DAO.Recordset
Set rst = frm.RecordsetClone
frm.Bookmark = rst.Bookmark
'move to 'new' record below 'last' record
SendKeys "{PGDN}", True
'copy data from Hold fields to fields in new record
frm![ipEmployeeNo] = HoldEmployeeNo
frm![ipProjtype] = HoldProjType
frm![ipProjDesc] = HoldProjDesc
frm![ipTime] = HoldTime
frm![ipDueDate] = HoldDueDate
frm![ipCompleteDate] = HoldCompleteDate
frm![ipProg#] = HoldProg
frm![ipMod#] = HoldMod
frm![ipImprove] = HoldImprove
frm![ipWorkplan] = HoldWorkPlan
frm![ipWorkUnits] = HoldWorkUnits
frm![ipComment] = HoldComment
'place cursor in Employee No Field
End Function

Open in new window

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.