Copy current record and sub records with different dates

  • Thread starter Thread starter heidii
  • Start date Start date
H

heidii

Hello All:

I am trying to allow my users to enter their recommendation, then have
a button on the form that will allow the user to copy the current
record plus the subform records, and just change the dates.

I have also placed on the form two text boxes that I thought would
help in determining the dates to use on the new pasted records.

Total Times to Repeat (say 2 times) copy record 2 times
What Intervals (say 2 days) change date of first copied record to 2
days after current record date and so on.

Tables:

tbl-recommendation
tbl-recommendationdetails
Forms:

frm-recommendation
frm-recommendationdetail (this is a subform on frm-recommendation)

The reason for wanting this is so that if my user makes a
recommendation and knows he is going to make the same recommendation
every 2 days, then it's easier to make the multiple date copy
available then have them retype all the new records.

Any help appreciated.
 
Sorry for the double post:

But I found some code by Allen Brown. Thank you. And it is working
for what I want to do. But I want to add a few more things to it that
I don't know how to do.

I modified Allen's code to meet some of my needs. But now I need help
with how to loop this code X number of times depending on a number in
my me.repeatquantity text box. That way my user does not have to
manually press the button that number of times.

Can someone help me with the code to make this code loop.

I have tried placing the code in a module and then running a query on
the onclick that runs the code with the repeat section of the
openquery argument set to repeat to [forms]![frm-recommendation-entry]!
[repeatquantity]. But then I get Errors on the following section of
my code:


'Save and edits first
If Me.Dirty Then
Me.Dirty = False
End If

'Make sure there is a record to duplicate.
If Me.NewRecord Then
MsgBox "Select the record to duplicate."
Else


If there a way to do the loop with the code I have pasted below just
from my forms button?

Here is the modified code:

Private Sub CMDDUPLICATE_Click()
'DUPLICATE RECORDS IF WEEKS ARE SELECTED If Me.REPEATREC = True And
Me.REPEATWEEKS >= 0 And Me.REPEATQUANTITY >= 0 Then

'On Error GoTo Err_Handler
'Purpose: Duplicate the main form record and related records in
the
subform.
Dim strSql As String 'SQL statement.
Dim lngID As Long 'Primary key value of the new record.

'Save and edits first
If Me.Dirty Then
Me.Dirty = False
End If

'Make sure there is a record to duplicate.
If Me.NewRecord Then
MsgBox "Select the record to duplicate."
Else
'Duplicate the main record: add to form's clone.
With Me.RecordsetClone
.AddNew
!CURRENTUSER = Me.CURRENTUSER
!RECNUMBER = Me.[RECAUTOID] + 1 &
Left(Me.RECUSER.Column(0),
1) & Left(Me.RECUSER.Column(1), 1) 'takes first intials of users
first
and last name + the AutoID number to create a unique key that is also
easily
identified visually.
!TARGETDATE = Me.TARGETDATE + (7 * [REPEATWEEKS])
!TYPEOFREC = Me.TYPEOFREC
!LOTNUMBER = Me.LOTNUMBER
!APPTYPE = Me.APPTYPE
!GALSPERACRE = Me.GALSPERACRE
!OPTTEMP = Me.OPTTEMP
!CROP = Me.CROP
!METHOD = Me.METHOD
!TIMIING = Me.TIMIING
!HALTREC = Me.HALTREC
!NOTES = Me.NOTES
!DATEMADE = Date
!RECUSER = Me.RECUSER
!REPEATWEEKS = Me.REPEATWEEKS
!REPEATQUANTITY = Me.REPEATQUANTITY - 1 'subtracts
one
from next new record taking original number down to zero so no more
new
records are created
If Me.REPEATQUANTITY = 1 Then
!REPEATREC = False
Else
!REPEATREC = True
End If

'etc for other fields.
.Update

'Save the primary key value, to use as the foreign key for
the
related records.
.Bookmark = .LastModified
lngID = !RECAUTOID





'Duplicate the related records: append query.
'If Me.[Orders Subform].Form.RecordsetClone.RecordCount >
0 Then
' strSql = "INSERT INTO [Order Details] ( OrderID,
ProductID,
Quantity, UnitPrice, Discount ) " & _
' "SELECT " & lngID & " As NewID, ProductID,
Quantity,
UnitPrice, Discount " & _
' "FROM [Order Details] WHERE OrderID = " &
Me.OrderID &
";"
'DBEngine(0)(0).Execute strSql, dbFailOnError
'Else
' MsgBox "Main record duplicated, but there were no
related
records."
' End If

'Display the new duplicate.
Me.Bookmark = .LastModified
End With
End If




Exit_Handler:
Exit Sub

Err_Handler:
MsgBox "Error " & Err.Number & " - " & Err.Description, ,
"cmdDupe_Click"
Resume Exit_Handler

Else
MsgBox "To duplicate recommendation to additional dates, check the
Repeat
Rec box, and enter the number of times to repeat and how many days
apart"
End If
End Sub
 
Back
Top