Duplicate an existing record with a subform to create a new record.

You'll find an example of a method for copying a row from a table and all the rows from referencing tables in one-to-many relationship types in CopyTree.zip in my public databases folder at:

https://onedrive.live.com/?cid=44CC60D7FEA42912&id=44CC60D7FEA42912!169

This little demo file copies a tree structured hierarchy of three tables Countries, Regions, and Cities via a button on a countries form with two correlated subforms for regions and cities.  The code employed is as follows:

Public Function CopyCountryTree(lngCountryID As Long)

    Dim strSQL As String

    Dim lngNewCountryID As Long

    Dim lngNewRegionID As Long

    Dim lngNewCityID As Long

    Dim rstRegions As DAO.Recordset

    ' get next CountryID value

    lngNewCountryID = DMax("CountryID", "Countries") + 1

    'insert new row into Countries

    strSQL = "INSERT INTO Countries(CountryID,Country) " & _

        "SELECT " & lngNewCountryID & ",Country " & _

        "FROM Countries WHERE CountryID = " & lngCountryID

    CurrentDb.Execute strSQL, dbFailOnError

    ' get Max RegionID value

    lngNewRegionID = DMax("RegionID", "Regions")

    strSQL = "SELECT Region FROM Regions WHERE CountryID = " & lngCountryID

    Set rstRegions = CurrentDb.OpenRecordset(strSQL)

    ' loop through set of Region values in country being copied

    ' and insert a new row into Regions, incrementing value of RegionID by 1

    ' at each iteration of the loop

    With rstRegions

        .MoveLast

        .MoveFirst

        Do While Not .EOF

            lngNewRegionID = lngNewRegionID + 1

            strSQL = "INSERT INTO Regions(RegionID,Region,CountryID) " & _

                "VALUES(" & lngNewRegionID & ",""" & .Fields("Region") & """," & lngNewCountryID & ")"

            CurrentDb.Execute strSQL, dbFailOnError

           .MoveNext

        Loop

    End With

     ' get Max CityID value

    lngNewCityID = DMax("CityID", "Cities")

    strSQL = "SELECT R1.RegionID, City FROM Regions AS R1,Cities AS C1 " & _

        "WHERE CountryID = " & lngNewCountryID & _

        " AND EXISTS" & _

            "(SELECT * " & _

            "FROM (Cities AS C2 INNER JOIN Regions  AS R2 " & _

            "ON C2.RegionID = R2.RegionID) " & _

            "INNER JOIN Countries " & _

            "ON Countries.CountryID = R2.CountryID " & _

            "WHERE Countries.CountryID = " & lngCountryID & _

            "AND R2.Region = R1.Region " & _

            "AND C2.CityID = C1.CityID)"

    Set rstRegions = CurrentDb.OpenRecordset(strSQL)

    ' loop through set of Region/City values in country being copied

    ' and insert a new row into Cities, incementing value of CityID by 1

    ' at each iteration of the loop

    With rstRegions

        .MoveLast

        .MoveFirst

        Do While Not .EOF

            lngNewCityID = lngNewCityID + 1

            strSQL = "INSERT INTO Cities(CityID,City,RegionID) " & _

                "VALUES(" & lngNewCityID & ",""" & .Fields("City") & """," & .Fields("RegionID") & ")"

            CurrentDb.Execute strSQL, dbFailOnError

           .MoveNext

        Loop

    End With

End Function

As you have only two tiers to the hierarchy, the lower part of a function like the above would not be required of course.

The above example is an absurd one of course, which would never be done in reality.  In fact, copying a whole tree in this way would be very unlikely, unless the tables are badly structured, which is the point Tom was making in his reply.  Your parent table is structured much as one would do when creating a spreadsheet in Excel.  Relational databases are very differently structured, however, being made up of multiple referenced and referencing related tables.  To achieve a correct structure would involve the decomposition of your main table into a set of correctly normalized related tables.

With correctly normalized tables the sort of process which you are attempting would be more like that illustrated in the second method in my demo, in which a many-to-many relationship type is duplicated between Orders and Products tables, modelled by an OrderDetails table, by means of the following code:

Public Function CopyMTMRel(lngOrderID As Long, lngCustomerID As Long)

    Dim rst As DAO.Recordset

    Dim strSQL As String

    Dim lngNextOrderID As Long

    Dim lngItemID As Long

    Dim intQuantity As Integer

    Dim curCurrentUnitPrice As Currency

    lngNextOrderID = DMax("OrderID", "Orders") + 1

    ' insert new row into orders with today's date as order date

    strSQL = "INSERT INTO Orders(OrderID,CustomerID,OrderDate) " & _

        "VALUES(" & lngNextOrderID & "," & lngCustomerID & ",#" & _

        Format(VBA.Date, "yyyy-mm-dd") & "#)"

    CurrentDb.Execute strSQL, dbFailOnError

    ' return recordset of current order's rows in OrderDetails

    ' and loop through recordset, inserting a new row

    ' at each iteration of the loop, with current unit price of item

    strSQL = "SELECT * FROM OrderDetails" & _

        " WHERE OrderID = " & lngOrderID

    Set rst = CurrentDb.OpenRecordset(strSQL)

    With rst

        If Not (.BOF And .EOF) Then

            .MoveLast

            .MoveFirst

            Do While Not .EOF

                lngItemID = .Fields("ItemID")

                intQuantity = .Fields("Quantity")

                ' get current unit price of item

                curCurrentUnitPrice = DLookup("UnitPrice", "Items", "ItemID = " & .Fields("ItemID"))

                strSQL = "INSERT INTO OrderDetails(OrderID,ItemID,UnitPrice,Quantity) " & _

                    "VALUES(" & lngNextOrderID & "," & lngItemID & "," & curCurrentUnitPrice & "," & intQuantity & ")"

                CurrentDb.Execute strSQL, dbFailOnError

                .MoveNext

            Loop

        End If

    End With

End Function

This not only copies the relationship by inserting new rows in OrderDetails, but also updates the unit prices of the products ordered, which is a scenario which might realistically be required in an operational database.

Hi Tom,

Actually, I just copied the actual source tables to save time since the main form and subform use the same field names. Thank you!

Hi Scott,

I’d like to duplicate all the listed attributes listed in both main and subform, except for the “AuditNo”. A new Audit number will be manually entered later. I was able to copy the main form recs but not the subform.

Other samples I tried are from other people seeking help with almost the same issue but no luck.

Thank you for taking the time.

Oh boy, THW_main is a spreadsheet, not a relational database. This is a gift that will keep on giving :-(

What have you tried?

What values do you need to duplicate?