Solved Duplicate multiple records AND their subrecords (1 Viewer)

[AJGarriton]

I have a database used for tracking product testing. I have a study table which has all the information for a specific study which is then linked to a table that has the details for the different timepoints (study interval table) the samples must be tested. Many product have annual testing requirements. I have created an append query that successfully identifies the studies that must be replicated, creates new records for those studies in the study table. There are over 100 of these studies. Can someone help me understand how to duplicate the study AND it's records in the study interval table? I know how to replicate a single study and it's subrecords. I do not know how to replicate 100 records and their subrecords.

Thanks in advance for any help possible.

 

[conception_native_0123]

I do not know how to replicate 100 records and their subrecords

this would be done by using an INSERT INTO query. you can do that to insert the records into a new table, then use the SELECT statement inside your query to get all of the records from the source to the target. if you have id numbers associated with the records, you can select all the IDs that you want and it should be smooth sailing from there.

 

[AJGarriton]

can you help me with the VBA?
Main Table = StudyTbl Fields = StudyID, StudyLot and Product
SubTable = IntervalTbl Fields = IntervalID, StudyIDLink, TimePoint

So, I have query "annualstudyqry" that identifies the records in the Main Table that I want to duplicate.

Thanks so much!

 

[MajP]

I would loop annualstudyqry and return the studyIDs. Then for each loop build the SELECT INTO statement where StudyIDLink = StudyID and execute the select into.

If you can post the real data I can write the code quickly.

 

[conception_native_0123]

can you help me with the VBA?

it seems as though majP wants to do it. he will do fine. I can do it for you as well, but I would need some data, real or fake, to do it for you, just like he would. do you have some?

 

[MajP]

Something like

Public Sub InsertChildRecs()
  Dim rs As DAO.Recordset
  Dim id As Long
  Dim strSql As String
  Set rs = CurrentDb.OpenRecordset("select StudyID from annualstudyqry order by studyID")
  Do While Not rs.EOF
    id = rs!studyID
    strSql = "SELECT IntervalID, StudyIDLink, TimePoint INTO IntervalTbl FROM IntervalTbl WHERE StudyIDLink = " & id
    CurrentDb.Execute strSql
    rs.MoveNext
  Loop
End Sub

 

[conception_native_0123]

Something like

hey Maj, are you sure the engine is good enough to execute all of that, that quickly? I have doubts, but it could be.

 

[MajP]

Yes. You are simply looping a 100 insert queries. Likely take a few seconds. But this could be done in a single insert that joinis annualstudyqry to intervalTbl which would be faster. Without seeing the data I went the easy route.

 

[conception_native_0123]

Without seeing the data I went the easy route

no doubt about that. ha ha very nice work.

 

[MajP]

Maybe something like.
"SELECT IntervalID, StudyIDLink, TimePoint INTO IntervalTbl FROM IntervalTbl inner join annualstudyqry ON StudyIDLink = studyID"

 

[AJGarriton]

Here is some data:

StudyTable (main table)
Study ID StudyLot Product
1 A21 Acetaminophen
2 A21 Ibuprophen
3 A20 Naproxen
4 A21 Loperimide

StudyIntervalTable (sub table)
IntervalID StudyIDLink Timepoint
1 1 Initial
2 1 6 months
3 1 12 months
4 2 Initial
5 2 4 months
6 2 9 months
7 3 Initial
8 3 3 months
9 3 6 months
10 4 Initial
11 4 6 months
12 4 12 months

My query looks at StudyTable finds the A21 Lots and adds records to the StudyTable as such
StudyID StudyLot Product
1 A21 Acetaminophen
2 A21 Ibuprophen
3 A20 Naproxen
4 A21 Loperimide
5 A22 Acetaminophen
6 A22 Ibuprophen
7 A22 Loperimide

But, I also need the query to add to the study interval table as such, this is what I do not know how to do.
StudyIntervalTable (sub table)
IntervalID StudyIDLink Timepoint
1 1 Initial
2 1 6 months
3 1 12 months
4 2 Initial
5 2 4 months
6 2 9 months
7 3 Initial
8 3 3 months
9 3 6 months
10 4 Initial
11 4 6 months
12 4 12 months
13 5 Initial
14 5 6 months
15 5 12 months
16 6 Initial
17 6 4 months
18 6 9 months
19 7 Initial
20 7 6 months
21 7 12 months

Thank you

 

[MajP]

Any chance you can put this into excel tables or a small database. To test this I would like to import into a datbase, but that would be some work in this format.

There may be a smarter way to do this, but I have done this in the past. The issue is that when you insert 21 Acetaminophen you get a newly generated study ID. You need the old ID and the new ID. 1 and 5. Then when you do your child insert you insert the new StudyIDlink of 5 where records have a studyIDlink of 1.

I would write my code like this where your pass in a StudyLot and create a recordset

So the pseudo code is something like

Public Sub DuplicateLots(studyLotToDup as String, NewLotID as String)
  dim strSql as string
  dim rs as dao.recordset
  dim rsChild as dao.recordset
  dim OldId
  Dim NewID
  set rs = currentdb.openrecordset("select * from StudyTable where StudyLot = '" & studyLot & "'")
  do while not rs.eof
    strSql = "Insert into StudyTable (StudyLot, Product) values ('" & NewLot & "', '" & RS!Product & "')"
    currentdb.execute strSql
    oldID = RS![Study ID]
    newID = dmax("[Study ID]","StudyTable")
    set RsChild = "Select * from StudyIntervaltable WHERE StudyIDLink = " & oldID
    do while not RS!child.eof
      rsChild.moveNext
      strSql = "Insert into StudyIntervalTable (StudyIDLink, TimePoint) VALUES (" & newID & ", '" & rsChild!TimePoint & "')"
      currentDb.execute StrSql
    loop
    rs.movenext
  loop
end sub

 

[AJGarriton]

Your help has been invaluable. I now have most of the cost working for my specifics, however, I'm getting an error I can't seem to identify and correct.

Here is my actual code"
Public Sub DuplicateLots()
Dim strSQL As String
Dim strSQL2 As String
Dim rs As DAO.Recordset
Dim rsChild As DAO.Recordset
Dim qdf As DAO.QueryDef
Dim qdfChild As DAO.QueryDef
Dim OldID
Dim NewID
Dim ActualYear As Integer
Dim NextYear As Integer
Dim AYear As String
Dim NYear As String

Dim SpecStatus As String
Dim StudyStatus As String
Dim Blanks As String

SpecStatus = "Active"
StudyStatus = "Scheduled"
Blanks = ""

ActualYear = Format(Now(), "YY")
NextYear = ActualYear + 1

AYear = "A" & Str(ActualYear)
NYear = "A" & Str(NextYear)

Set qdf = CurrentDb.QueryDefs("CreateAnnualStudyforVBA")
qdf.Parameters("[ActualYear]").Value = AYear

Set rs = qdf.OpenRecordset

Do While Not rs.EOF
strSQL = "INSERT INTO Studies (Product, MBRStatus, Dating, StudyStatus, StudyLot, Distributor, Manufacturer, SupplierNDC, Method, Lab, BlisterMaterial, FormTool, SealTool, QuotedIntervalCost, SpecialInstructions, QtySmpPerInterval, Bracketed, GenericPC, ProductCode, FamilyID, DateCreated, MBRRev, QuotedConsumables ) values ('" & rs!Product & "','" & SpecStatus & "','" & rs!Dating & "','" & StudyStatus & "','" & NYear & "','" & rs!Distributor & "' ,'" & rs!Manufacturer & "' ,'" & rs!SupplierNDC & "' ,'" & rs!Method & "' ,'" & rs!Lab & "' ,'" & rs!BlisterMaterial & "' ,'" & rs!FormTool & "' ,'" & rs!SealTool & "' ,'" & rs!QuotedIntervalCost & "' ,'" & rs!SpecialInstructions & "' ,'" & rs!QtySmpPerInterval & "' ,'" & rs!Bracketed & "' ,'" & Left(rs!GenericPC, 5) & "' ,'" & rs!ProductCode & "' ,'" & rs!FamilyID & "' ,'" & Date & "' ,'" & rs!MBRRev & "' ,'" & rs!QuotedConsumables & "')"

CurrentDb.Execute strSQL
OldID = rs![StudyID]
NewID = DMax("[StudyID]", "Studies")

Set qdfChild = CurrentDb.QueryDefs("CreateAnnualIntervals")
qdfChild.Parameters("[OldID]").Value = OldID

Set rsChild = qdfChild.OpenRecordset

Do While Not rsChild.EOF

strSQL2 = "Insert into StudyIntervalData (StudyIDLink, Timepoint) Values ('" & NewID & "','" & rsChild!TimePoint & "')"
CurrentDb.Execute strSQL2
rsChild.MoveNext
Loop
rs.MoveNext

Loop

End Sub

The error is Run Time error 3075. The error starts with the field rs!Distributor. I first thought the issue was this field could contain an ' or .. So, I modified my query to remove ',.,( and )… trying to cover all bases. However, I am still getting the error,

Any thoughts? Could hyphens in that field cause a problem?

Again, I certainly appreciate all the help!!!

 

[MajP]

Could hyphens in that field cause a problem?

Yes most definitely. Never use spaces, or any special characters except underscores.
I always make my strSql and then before writing more code I debug.print StrSql to see what it resolves to. Please add a debug.print strSQl.
Remember on an insert : #SomeDate#, 'Some Text', SomeNumber
I see a costs and ID with single quotes, and I would expect numeric.

 

[AJGarriton]

Thanks for such quick responses. Yes, I have some currency fields and number fields. I will work on this tomorrow.

You are teaching me much!!!

 

[MajP]

To make inserts easier I use this function. Then you do not have to worry about the datatypes

Public Function ParamInsert(TableName As String, TheFields As String, ParamArray TheValues() As Variant) As String
  Dim qdf As QueryDef
  Dim i As Integer
  Dim MyParams As New Collection
  Dim strMyParams As String
  Dim strSql As String
  If Left(TheFields, 1) <> "(" Then TheFields = "(" & TheFields & ")"
 
  For i = 0 To UBound(TheValues)
    MyParams.Add "Param" & i, "Param" & i
    If strMyParams = "" Then
      strMyParams = "[" & MyParams(i + 1) & "]"
    Else
      strMyParams = strMyParams & ", " & "[" & MyParams(i + 1) & "]"
    End If
  Next i
  strSql = "INSERT INTO " & TableName & " " & TheFields & " VALUES ( " & strMyParams & ")"
  ParamInsert = strSql
  Set qdf = CurrentDb.CreateQueryDef("TempQuery", strSql)
   For i = 0 To UBound(TheValues)
    qdf.Parameters(i) = TheValues(i)
  Next i
  qdf.Execute
  CurrentDb.QueryDefs.Delete ("tempquery")
End Function

Public Sub TestParamInsert()
  Dim TheFields As String
  Dim FirstName As Variant
  Dim LastName As Variant
  FirstName = Null
  LastName = "Smith"
  TheFields = "(FirstName, LastName, OrderID, OrderDate)"
  ParamInsert "MyTable", TheFields, FirstName, LastName, 1, Date
End Sub

So in your case the insert should be

ParamInsert "Studies","Product, MBRStatus, Dating, StudyStatus, StudyLot, Distributor, Manufacturer, SupplierNDC, Method, Lab, BlisterMaterial, FormTool, SealTool, QuotedIntervalCost, SpecialInstructions, QtySmpPerInterval, Bracketed, GenericPC, ProductCode, FamilyID, DateCreated, MBRRev, QuotedConsumables", rs!Product , SpecStatus ,rs!Dating ,StudyStatus,NYear,rs!Distributor, rs!Manufacturer,rs!SupplierNDC,rs!Method, rs!Lab,rs!BlisterMaterial,rs!FormTool,rs!SealTool, rs!QuotedIntervalCost,rs!SpecialInstructions,rs!QtySmpPerInterval,rs!Bracketed,Left(rs!GenericPC, 5),rs!ProductCode,rs!FamilyID,Date,rs!MBRRev,rs!QuotedConsumables

That is still pretty challenging to get correct.

 

[MajP]

Also another thing to always get the delimiters correct is my CSql function

Get Filter from Controls, CSQL, and Combine Multiple Filters

If you follow my threads, I try to demonstrate how to write code that is flexible, generic, encapsulated, fault proof, and debuggable. My goal is always to try to write code once that can be re-used often and everywhere. I do this in functions, procedures, and class modules. This may require...

www.access-programmers.co.uk

Then it is just Csql(rs!Product) and it will add #,',and format as necessary. More importantly it handles NULL values. If any of your values above are Null the insert will fail. The CSQL returns the literal string NULL and thus can insert a null value.

 

[MajP]

With that said I would put in a little extra work to make it easier in the long run and put all of your values into variables.

dim product as string
dim dating as string
dim studyStatus as string
...
dim QuotedConsumables as string

product = Csql(rs!Product)
dating = Csql(rs!Dating)
...
QuotedConsumables = Csql(Rs!quotedConsumables)

Then the insert string gets simpler
... Values (" & Product & ", " & Dating & ", "... & QuotedConsumables & ")"

 

[arnelgp]

another late sample.

 

[arnelgp]

Then you do not have to worry about the datatypes

almost same: (1) fnAnySQL() parameter query | Access World Forums (access-programmers.co.uk)