Duplication Loop Required based on Inputbox answer (1 Viewer)

S1LV3RF0X87

Registered User.
Local time
Today, 11:13
Joined
Jul 7, 2017
Messages
26
Hello i wonder if someone can help me as i cant seem to find an answer any where to what i need.

I have a form where a user can input data into it. I have a duplicate record function for where the user can duplicate the record as many time as they want, however when they are wanting to duplicate the same record multiple times they want a function to where they are prompted to input a set number then the duplication function then loops until it meets the criteria.

This is my duplication code

Code:
Private Sub Command158_Click()
On Error GoTo Command158_Click_Err

    ' _AXL:<?xml version="1.0" encoding="UTF-16" standalone="no"?>
    ' <UserInterfaceMacro For="Command722" Event="OnClick" xmlns="http://schemas.microsoft.com/office/accessservices/2009/11/application"><Statements><Action Name="SaveRecord"/><Action Name="Requer
    ' _AXL:y"/></Statements></UserInterfaceMacro>
    On Error Resume Next
    DoCmd.RunCommand acCmdSelectRecord
    If (MacroError = 0) Then
        DoCmd.RunCommand acCmdCopy
    End If
    If (MacroError = 0) Then
        DoCmd.RunCommand acCmdRecordsGoToNew
    End If
    If (MacroError = 0) Then
        DoCmd.RunCommand acCmdSelectRecord
    End If
    If (MacroError = 0) Then
        DoCmd.RunCommand acCmdPaste
    End If
    If (MacroError <> 0) Then
        Beep
        MsgBox MacroError.Description, vbOKOnly, ""
    End If


Command158_Click_Exit:
    Exit Sub

Command158_Click_Err:
    MsgBox Error$
    Resume Command158_Click_Exit

End Sub

I have been trialing the inputbox command to prompt the user with the question.

Here is the code for that.
Code:
Private Sub Command278_Click()

Dim sReturn As String
sReturn = InputBox("How many more duplicates do you require?", _
                   "Duplication Request")

End Sub

I don't know how to merge the 2 codes together and get them to work properly.

Any help on this matter would be appreciated.
 

Uncle Gizmo

Nifty Access Guy
Staff member
Local time
Today, 19:13
Joined
Jul 9, 2003
Messages
13,416
What about something like this? You select a record in your subform (displayed in datasheet view) and it creates as many new records as you want...

 

bastanu

AWF VIP
Local time
Today, 11:13
Joined
Apr 13, 2010
Messages
865
Here is how to use a simple loop with your sample code (there are better ways to copy a record than what you're using):
Code:
Private Sub Command278_Click()

Dim sReturn As String
sReturn = InputBox("How many more duplicates do you require?", _
                   "Duplication Request")
If IsNumeric(sReturn) then Call vcDuplicateRecord(cInt(sReturn))

End Sub



Public Sub vcDuplicateRecord(iCount as integer)
On Error GoTo vcDuplicateRecord_Err

If Nz(iCount)=0 then exit sub

Dim i as Integer

For i=1 to iCount
    ' _AXL:<?xml version="1.0" encoding="UTF-16" standalone="no"?>
    ' <UserInterfaceMacro For="Command722" Event="OnClick" xmlns="http://schemas.microsoft.com/office/accessservices/2009/11/application"><Statements><Action Name="SaveRecord"/><Action Name="Requer
    ' _AXL:y"/></Statements></UserInterfaceMacro>
    On Error Resume Next
    DoCmd.RunCommand acCmdSelectRecord
    If (MacroError = 0) Then
        DoCmd.RunCommand acCmdCopy
    End If
    If (MacroError = 0) Then
        DoCmd.RunCommand acCmdRecordsGoToNew
    End If
    If (MacroError = 0) Then
        DoCmd.RunCommand acCmdSelectRecord
    End If
    If (MacroError = 0) Then
        DoCmd.RunCommand acCmdPaste
    End If
    If (MacroError <> 0) Then
        Beep
        MsgBox MacroError.Description, vbOKOnly, ""
    End If
Next i

vcDuplicateRecord_Exit:
    Exit Sub

vcDuplicateRecord_Err:
    MsgBox Error$
    Resume vcDuplicateRecord_Exit
End Function

Cheers,
 

S1LV3RF0X87

Registered User.
Local time
Today, 11:13
Joined
Jul 7, 2017
Messages
26
I have tried your suggestion Bastanu but it only creates 1 duplicate record regardless of the quantity i input.

Any other suggestions?
 

bastanu

AWF VIP
Local time
Today, 11:13
Joined
Apr 13, 2010
Messages
865
Can you try this updated version:
Code:
Public Sub vcDuplicateRecord(iCount as integer)
On Error GoTo vcDuplicateRecord_Err

If Nz(iCount)=0 then exit sub

Dim i as Integer


    ' _AXL:<?xml version="1.0" encoding="UTF-16" standalone="no"?>
    ' <UserInterfaceMacro For="Command722" Event="OnClick" xmlns="http://schemas.microsoft.com/office/accessservices/2009/11/application"><Statements><Action Name="SaveRecord"/><Action Name="Requer
    ' _AXL:y"/></Statements></UserInterfaceMacro>
    On Error Resume Next
    DoCmd.RunCommand acCmdSelectRecord
    If (MacroError = 0) Then
        DoCmd.RunCommand acCmdCopy
    End If
For i=1 to iCount
    If (MacroError = 0) Then
        DoCmd.RunCommand acCmdRecordsGoToNew
    End If
    If (MacroError = 0) Then
        DoCmd.RunCommand acCmdSelectRecord
    End If
    If (MacroError = 0) Then
        DoCmd.RunCommand acCmdPaste
    End If
    If (MacroError <> 0) Then
        Beep
        MsgBox MacroError.Description, vbOKOnly, ""
    End If
Next i

vcDuplicateRecord_Exit:
    Exit Sub

vcDuplicateRecord_Err:
    MsgBox Error$
    Resume vcDuplicateRecord_Exit
End Function

Cheers,
Vlad
 

S1LV3RF0X87

Registered User.
Local time
Today, 11:13
Joined
Jul 7, 2017
Messages
26
Great that works but i ran into a snag which am now not sure what's best way to handle it. I may need to have a think on the best way to deal with this new problem.

Long story short, when the duplicate function kicks in an creates a new record there is a set field which looks at what has been inputted which then runs the following code after update.

The purpose of this is to update the fields on the form with the correct information from the product field which has just been duplicated. However when it gets to the If IsNull statement it is checking to see if that product has populated another field with a value and if it hasn't then it simply exits the sub an the above duplicate function does what its supposed to do and create the records until it meets the set qty criteria.

However if the suggestionid field has a value then it moves over to the else function and and opens another form to allow the user to add the suggested item to the system. When it does this, this then kills the duplication process in its tracks and it doesn't create any more duplicates of the previous record.

I will need to have a think on the best cause of action on how to handle this scenario within the system but would it be possible to bypass this afterupdate event to allow the duplication function to work?

Code:
Private Sub Product_AfterUpdate()
[DefaultRRP] = DLookup("ServiceDefaultRRP", "ServiceChargestbl", "ProductID=" & [Product])
[DefaultCost] = DLookup("ServiceDefaultCost", "ServiceChargestbl", "ProductID=" & [Product])
[DefaultBaseLine] = DLookup("ServiceDefaultBaseLine", "ServiceChargestbl", "ProductID=" & [Product])
[S-Frequency] = DLookup("Frequency", "ServiceChargestbl", "ProductID=" & [Product])
[S-MIA] = DLookup("MonthsInAdvance", "ServiceChargestbl", "ProductID=" & [Product])
[S-CIA] = DLookup("CashInAdvance", "ServiceChargestbl", "ProductID=" & [Product])
[SB] = DLookup("Bonus", "ServiceChargestbl", "ProductID=" & [Product])
[S-BonusApplicable] = DLookup("BonusApplicable", "ServiceChargestbl", "ProductID=" & [Product])
[S-BonusOnlyCharge] = DLookup("BonusOnlyCharge", "ServiceChargestbl", "ProductID=" & [Product])
[Buy_Day_Rate] = DLookup("SCBuy_Day_Rate", "ServiceChargestbl", "ProductID=" & [Product])
[Buy_Night_Rate] = DLookup("SCBuy_Night_Rate", "ServiceChargestbl", "ProductID=" & [Product])
[Buy_Weekend_Rate] = DLookup("SCBuy_Weekend_Rate", "ServiceChargestbl", "ProductID=" & [Product])
[Buy_Standing_Charge] = DLookup("SCBuy_Standing_Charge", "ServiceChargestbl", "ProductID=" & [Product])
[Sell_Day_Rate] = DLookup("SCSell_Day_Rate", "ServiceChargestbl", "ProductID=" & [Product])
[Sell_Night_Rate] = DLookup("SCSell_Night_Rate", "ServiceChargestbl", "ProductID=" & [Product])
[Sell_Weekend_Rate] = DLookup("SCSell_Weekend_Rate", "ServiceChargestbl", "ProductID=" & [Product])
[Sell_Standing_Charge] = DLookup("SCSell_Standing_Charge", "ServiceChargestbl", "ProductID=" & [Product])
[SuggestionID] = DLookup("ArticleID", "ServiceChargestbl", "ProductID=" & [Product])

DoCmd.Save


If IsNull([Forms]![ProposalNavForm-BO]![NavigationSubform]![SuggestionID]) Then

Exit Sub

Else

DoCmd.OpenForm "OrderSuggestions-BONS"

End If

End Sub
 

bastanu

AWF VIP
Local time
Today, 11:13
Joined
Apr 13, 2010
Messages
865
That is why I mentioned earlier that there are better ways to achieve this. Yes, the AfterUpdate code can be bypassed (by using a global boolean variable with the default of False and setting it to True in the duplication sub), but then you have to populate all the new records with all that info in the AfterUpdate and the separate form.

I would replace all this with a properly constructed append query based on a select query that can be visually inspected to ensure data integrity.

For a quick fix try to comment out this line: '[SuggestionID] = DLookup("ArticleID", "ServiceChargestbl", "ProductID=" & [Product])
Now the code will always exit because the IsNull([Forms]![ProposalNavForm-BO]![NavigationSubform]![SuggestionID]) will always be True.

Cheers,
 

Users who are viewing this thread

Top Bottom