Create Duplication of information from a created quote to three tables

[Blings]

Good morning everyone,


I have a quotation database that works extremely well, from time to time we need to revise a quotation and by doing so I have created a revision feature which will automatically increment the quote number for e.g. quote no. 1 when revised to 1a, 1b, 1c, etc when the "Create Revision" button is clicked.




See quote no. 40 for example below which I will revise:



Here is the revision:- My question is, is it possible if when I "Create Revision" I can duplicate the above information into the Issued To table and Quote Details table?

[Blings]

This is the code on the "Create Revision" button:-

Private Sub cmdDup_Click()


Dim strSQL As String


Dim strProject As String
Dim dteFollowUpDate As Date
Dim lngQuoteNo As Long
Dim strRevision As String
Dim lngRaisedByID As Long
Dim strQuoteValue As String
Dim dteDateCreated As Date
Dim dteMonthExpected As Date
Dim lngStatusID As Long
Dim lngSourceID As Long
Dim lngSalesEngineerID As Long
Dim strDelivery As String
Dim dteValidTo As String


strProject = Me.Project
dteFollowUpDate = Me.FollowUpDate
lngQuoteNo = Me.QuoteNo
strRevision = StrNulls(Me.Revision)
lngRaisedByID = Me.RaisedBYID
strQuoteValue = Me.QuoteValue
dteDateCreated = Date
dteMonthExpected = Me.MonthExpected
lngStatusID = Me.StatsuID
lngSourceID = Me.SourceID
lngSalesEngineerID = Me.SalesEngineerID
strDelivery = Me.Delivery
dteValidTo = Me.ValidTo


strSQL = "INSERT INTO tblProvisionalQuotes ( Project, FollowUpDate, QuoteNo, Revision, RaisedbyID, QuoteValue, DateCreated, MonthExpected, StatsuID, SourceID, SalesEngineerID, Delivery, ValidTo) " _
& "Values ('" & strProject & "', " & Format(dteFollowUpDate, "\#dd\-mmm\-yyyy\#") & ", " & lngQuoteNo & ",'" & IncrementLetter2(strRevision) & "', " & lngRaisedByID & ", '" & strQuoteValue & _
"', " & Format(dteDateCreated, "\#dd\-mmm\-yyyy\#") & ", " & Format(dteMonthExpected, "\#dd\-mmm\-yyyy\#") & ", " & lngStatusID & ", " & lngSourceID & ", " & lngSalesEngineerID & ", '" & strDelivery & "', " & Format(dteValidTo, "\#dd\-mmm\-yyyy\#") & ");"
Debug.Print strSQL
CurrentDb.Execute strSQL, dbFailOnError


MsgBox "Quote Duplicated", vbInformation






End Sub

[Minty]

Do you ever go back to an earlier revision?
If not then simply have a seperate revision field and update that, and edit the existing quote, rather than storing all the data again.

Or simply have a RevisedQuoteNum field and copy the record to a completely new Quote number without the suffix.
Store the new quote number in the RevisedQuoteNum and you have an audit trail?

You can also simplify the duplication using the current quote number in your sql and remove the need for all those variables;

strSql = "INSERT INTO tblProvisionalQuotes ( Project, FollowUpDate, QuoteNo, Revision, RaisedbyID, QuoteValue, DateCreated, MonthExpected, StatsuID, SourceID, SalesEngineerID, Delivery, ValidTo) " _
& " SELECT Project, FollowUpDate, QuoteNo, Revision, RaisedbyID, QuoteValue, DateCreated, MonthExpected, StatsuID, SourceID, SalesEngineerID, Delivery, ValidTo " _
& " FROM tblProvisionalQuotes WHERE QuoteNo = '" & YourExistingQuoteNumber & "'"
Debug.Print strSql
CurrentDb.Execute strSql, dbFailOnError

[pbaldy]

The key to duplicating the related table's records is getting the key value for the main record just inserted. Here's one way:

http://allenbrowne.com/ser-57.html

[Blings]

Hello Minty, no, we generally don't go back to an earlier revision, however, keeping an audit trail of the revision is great as it's always good for us to review what we have previously issued to whom and what the items were so keeping the 1st quote which is the original number and then revising it by duplicating the data is great for the quote revision.


The simplification code above is fantastic, I'll try incorporate that now on a backup database.


Can I grab data from the two subForms: 1) frmQuotesIssuedTosubform [tblQuotesIssuedTo] & 2) frmQuoteDetailsSubform [tblQuoteDetails] ?

[pbaldy]

Can I grab data from the two subForms: 1) frmQuotesIssuedTosubform [tblQuotesIssuedTo] & 2) frmQuoteDetailsSubform [tblQuoteDetails] ?

Did you notice post 4?

[Blings]

Did you notice post 4?

I'll give that a bash then come back here when I get stuck, thank you.

[pbaldy]

No worries, I've used it so I know it works.

[Blings]

I am struggling:-

Private Sub cmdDup_Click()

Dim strSQL As String
Dim lngID As Long


If Me.Dirty Then
   Me.Dirty = False
End If


If Me.NewRecord Then
        MsgBox "Select the record to duplicate."
    Else
    
    With Me.RecordsetClone
            .AddNew
                !Project = Me.Project
                !FollowUpDate = Me.FollowUpDate
                !QuoteNo = Me.QuoteNo
                !Revision = Me.Revision
                !RaisedBYID = Me.RaisedBYID
                !QuoteValue = Me.QuoteValue
                !DateCreated = Me.DateCreated
                !MonthExpected = Me.MonthExpected
                !StatsuID = Me.StatsuID
                !SourceID = Me.SourceID
                !SalesEngineerID = Me.SalesEngineerID
                !Delivery = Me.Delivery
                !ValidTo = Me.ValidTo
            .Update
            
            .Bookmark = .LastModified
            lngID = ProvisionalQuoteID
            
            If Me.[frmQuoteDetailsSubform].Form.RecordsetClone.RecordCount > 0 Then
                strSQL = "INSERT INTO [tblQuoteDetails] (QuoteDetailID, ProvisionalQuoteID, TypeID, Code, Description, Qty, SalePrice, Ref ) " & _
                         "SELECT " & lngID & " As NewID, ProvisionalQuoteID, TypeID, Code, Description, Qty, SalePrice, Ref " & _
                         "FROM [tblQuoteDetails] WHERE ProvisionalQuoteID = " & Me.ProvisionalQuoteID & ";"
                'DBEngine(0)(0).Execute strSQL, dbFailOnError
            Else
                MsgBox "Main record duplicated, but there were no related records."
            End If


            Me.Bookmark = .LastModified
        End With
    End If


Exit_Handler:
    Exit Sub


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

[pbaldy]

With what exactly? If the SQL is throwing an error, this will help find the problem:

http://www.baldyweb.com/ImmediateWindow.htm

[kd2017]

Here's my psuedo attempt at a solution. Inspect it line by line for correct field names, table names, control names, etc.

Public Sub test()
On Error GoTo ErrHandler
    Dim db As DAO.Database
    Dim sql As String
    Dim newRevisionNo As String
    Dim originalQuoteId As Variant
    Dim revisedQuoteId As Variant
    
    'do some preflight checking - make sure the user should be allowed to do this
    If IsNull(Me.quoteId) Then Err.Raise 1001, , "The original quote hasn't even been saved. You can't do that yet."
    
    
    '1. Establish the new revision number
    newRevisionNo = IncrementLetter2(StrNulls(Me.Revision))
    
    'figure out what the original quote's id number is
    'originalQuoteId = DLookup("QuoteId", "tblProvisionalQuotes", "QuoteNo=" & Me.QuoteNo & " AND Revision='" & Me.Revision & "'")
    originalQuoteId = Me.quoteId
    
    '2. Duplicate the quote record with the incremented revision number
    sql = "INSERT INTO tblProvisionalQuotes ( Project, FollowUpDate, QuoteNo, Revision, RaisedbyID, QuoteValue, DateCreated, MonthExpected, StatsuID, SourceID, SalesEngineerID, Delivery, ValidTo) "
    sql = sql & vbCrLf & "SELECT pq.Project, pq.FollowUpDate, pq.QuoteNo, "
    sql = sql & vbCrLf & "       """ & newRevisionNo & """, pq.RaisedbyID, pq.QuoteValue, "
    sql = sql & vbCrLf & "       pq.DateCreated, pq.MonthExpected, pq.StatsuID, "
    sql = sql & vbCrLf & "       pq.SourceID, pq.SalesEngineerID, pq.Delivery, pq.ValidTo"
    sql = sql & vbCrLf & "FROM tblProvisionalQuotes AS pq"
    sql = sql & vbCrLf & "WHERE pq.QuoteId = " & originalQuoteId
    
    Debug.Print sql
    'db.Execute sql, dbFailOnError '<-- uncomment to execute
    
    revisedQuoteId = DLookup("QuoteId", "tblProvisionalQuotes", "QuoteNo=" & Me.QuoteNo & " AND Revision='" & newRevisionNo & "'")
    
    'throw an error if the quote wasn't successflly duplicated
    If IsNull(revisedQuoteId) Then Err.Raise 1001, , "Failed to find duplicated record"
    
    
    '3. Copy associated records from the issued to table in the same manner as step 2
    sql = "INSERT INTO tblIssuedTo ( field_name_1, field_name_2, field_name_N, QuoteId )"
    sql = sql & vbCrLf & "SELECT field_name_1, field_name_2, field_name_N, " & revisedQuoteId
    sql = sql & vbCrLf & "FROM tblIssuedTo"
    sql = sql & vbCrLf & "WHERE QuoteId = " & originalQuoteId
    
    Debug.Print vbCrLf & sql
    'db.Execute sql, dbFailOnError '<-- uncomment to execute
    
    
    '4. Copy associated records from the Quote details table in the same manner as step 2
    sql = "INSERT INTO tblQuoteDetails ( field_name_1, field_name_2, field_name_N, QuoteId )"
    sql = sql & vbCrLf & "SELECT field_name_1, field_name_2, field_name_N, " & revisedQuoteId
    sql = sql & vbCrLf & "FROM tblQuoteDetails"
    sql = sql & vbCrLf & "WHERE QuoteId = " & originalQuoteId
    
    Debug.Print vbCrLf & sql
    'db.Execute sql, dbFailOnError '<-- uncomment to execute
    
ExitHandler:
    Set db = Nothing
    Exit Sub
    
ErrHandler:
    MsgBox Err.Description, , "Error #" & Err.Number
    Resume ExitHandler
End Sub

[Blings]

Hi Paul,

I'm using the code below but I am getting the following error:

Private Sub cmdDup_Click()Dim strSQL As String
Dim lngID As Long


Dim strProject As String
Dim dteFollowUpDate As Date
Dim lngQuoteNo As Long
Dim strRevision As String
Dim lngRaisedByID As Long
Dim strQuoteValue As String
Dim dteDateCreated As Date
Dim dteMonthExpected As Date
Dim lngStatusID As Long
Dim lngSourceID As Long
Dim lngSalesEngineerID As Long
Dim strDelivery As String
Dim dteValidTo As String


Dim lngTypeID As Long
Dim lngCodeID As Long
Dim strDescription As String
Dim lngQty As Long
Dim lngDiscountID As Long
Dim curSalePrice As Currency
Dim strRef As String


strProject = Me.Project
dteFollowUpDate = Me.FollowUpDate
lngQuoteNo = Me.QuoteNo
strRevision = StrNulls(Me.Revision)
lngRaisedByID = Me.RaisedBYID
strQuoteValue = Me.QuoteValue
dteDateCreated = Date
dteMonthExpected = Me.MonthExpected
lngStatusID = Me.StatsuID
lngSourceID = Me.SourceID
lngSalesEngineerID = Me.SalesEngineerID
strDelivery = Me.Delivery
dteValidTo = Me.ValidTo


lngTypeID = Me.TypeID
lngCodeID = Me.CodeID
strDescription = Me.Description
lngQty = Me.Qty
lngDiscountID = Me.DiscountID
curSalePrice = Me.SalePrice
strRef = Nz(Ref, "Null")


strSQL = "INSERT INTO tblProvisionalQuotes ( Project, FollowUpDate, QuoteNo, Revision, RaisedbyID, QuoteValue, DateCreated, MonthExpected, StatsuID, SourceID, SalesEngineerID, Delivery, ValidTo) " _
& "Values ('" & strProject & "', " & Format(dteFollowUpDate, "\#dd\-mmm\-yyyy\#") & ", " & lngQuoteNo & ",'" & IncrementLetter2(strRevision) & "', " & lngRaisedByID & ", '" & strQuoteValue & _
"', " & Format(dteDateCreated, "\#dd\-mmm\-yyyy\#") & ", " & Format(dteMonthExpected, "\#dd\-mmm\-yyyy\#") & ", " & lngStatusID & ", " & lngSourceID & ", " & lngSalesEngineerID & ", '" & strDelivery & "', " & Format(dteValidTo, "\#dd\-mmm\-yyyy\#") & ");"
    Debug.Print strSQL
    CurrentDb.Execute strSQL, dbFailOnError


MsgBox "Quote Duplicated", vbInformation


'=============='
Dim rsTemp As DAO.Recordset
Dim i As Integer


'Create a copy of this forms Recordset


Set rsTemp = Me.RecordsetClone
rsTemp.MoveFirst


'Loop through all records and insert records....
For i = 1 To rsTemp.RecordCount




            lngID = Me.txtProvisionalQuoteID
            
                strSQL = "INSERT INTO tblQuoteDetails (ProvisionalQuoteID, TypeID, CodeID, Description, Qty, DiscountID, SalePrice, Ref ) " & _
                         "Values " & lngID & ", " & TypeID & ", " & CodeID & ", '" & Description & "', " & Qty & ", " & DiscountID & ", '" & SalePrice & "', '" & Nz(Ref, "Null") & _
                         "' FROM tblQuoteDetails WHERE ProvisionalQuoteID = " & Me.txtProvisionalQuoteID & ";"
                Debug.Print strSQL
                CurrentDb.Execute strSQL, dbFailOnError
                Next i
            
                rsTemp.Close


                Set rsTemp = Nothing


Exit_Handler:
    Exit Sub


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

[Welshgasman]

So debug.Print strSQL and post the output back here?

[Blings]

Here we go.

[Welshgasman]

No
Post the output of the Debug.Print strSQL (in the line above that Execute line) that will be in the immediate window (Ctrl + G)