create duplicat record with condition (1 Viewer)

tt1611

Registered User.
Local time
Yesterday, 21:11
Joined
Jul 17, 2009
Messages
132
Hello All
I have an excel sheet that we have to download from a given source and I am using access to populate this record directly to SQL server to be used by a barcoding label app.

The problem I have run into with my app is that each record inthe sheet has a quantity column attached to a given number
example

number 00001 black table with chair set Quantity 1
number 00005 white desk with top cloth Quantity 16

the numbers are supposed to be unique for each record but clearly we see that 16 white desks belong to the same number. When the app goes in to print the barcodes based on the code behind it, naturally it prints out only one label and the requirement is to print 16. I have no unique way of doing this as number 00005 is tied to one record not 16.

My questions are
a) is there a way to run a query (in access or vba) to return x amount of records based on quantity number
ie if 00005 has quantity 16 then my query would return 16 lines each with the same record but tagged with a unique id or
b) is there any code that one may have to split these records at insert time to 16 separate records each with an autonumber PK that would make each record unique.

The data cannot be modified from the source because we receive updated copies of this sheet with 2000+ rows at least once a week. Going through each record in excel and splitting down to its associated quantity - well this could only take years to do.

Any help is appreciated guys.
 

apr pillai

AWF VIP
Local time
Today, 06:41
Joined
Jan 20, 2005
Messages
735
I found your issue somewhat interesting and thought of finding a solution to it. Developed a VBA Routine for it and I hope it will solve your problem. The Code is given below:

Code:
Public Function Duplicate(ByVal inTable As String, ByVal outTable As String, ByVal KeyFieldName As String)
Dim db As Database, j As Integer, qty As Long, k As Long, T As Long
Dim fldLoop As Field, rst1 As Recordset, rst2 As Recordset
Dim tbldef1 As TableDef, tbldef2 As TableDef

On Error Resume Next

Set db = CurrentDb
Set tbldef1 = db.TableDefs(inTable)
GoSub CreateTable

On Error GoTo Duplicate_Err

Set rst1 = db.OpenRecordset(inTable, dbOpenDynaset)
Set rst2 = db.OpenRecordset(outTable, dbOpenDynaset)

Do While Not rst1.EOF
qty = rst1.Fields("Quantity").Value
T = 0
For j = 1 To qty
rst2.AddNew
  For Each fldLoop In tbldef2.Fields
     If fldLoop.Name = "ID" Then
       k = k + 1
       rst2.Fields(fldLoop.Name).Value = k
     ElseIf fldLoop.Name = KeyFieldName Then
       T = T + 1
       rst2.Fields(fldLoop.Name).Value = Trim(rst1.Fields(fldLoop.Name).Value) & Format(T, "000")
     Else
        rst2.Fields(fldLoop.Name).Value = rst1.Fields(fldLoop.Name).Value
    End If
  Next
  rst2.Update
Next
rst1.MoveNext
Loop
rst1.Close
rst2.Close


Set db = Nothing
Set tbldef2 = Nothing
Set tbldef1 = Nothing

Duplicate_Exit:
Exit Function

CreateTable:
Set tbldef2 = db.CreateTableDef(outTable)

Repeat:
Set fldLoop = tbldef2.CreateField("ID", 4, 4)
tbldef2.Fields.Append fldLoop

For Each fldLoop In tbldef1.Fields
    Set fldLoop = tbldef2.CreateField(fldLoop.Name, fldLoop.Type, fldLoop.Size)
    tbldef2.Fields.Append fldLoop
Next

db.TableDefs.Append tbldef2

If Err = 3010 Then
   db.TableDefs.Delete outTable
   db.TableDefs.Refresh
   Set tbldef2 = db.CreateTableDef(outTable)
   Err.Clear
   GoTo Repeat
End If

db.TableDefs.Refresh
Return


Duplicate_Err:
MsgBox Err.Description, , "Duplicate()"
Resume Duplicate_Exit

End Function

You can run the Duplicate() Function from a Command Button Click Event Procedure or from the Debug Window directly as given below:

Duplicate "Table3","Table4","Keyx"

  • "Table3" is the original Table with the Data. If it is a Query then you need to modify the code to open a QueryDef Object rather than TableDef.
  • "Table4" is the Target Table Name. This is created automatically with the same structure of Table3, but with an additional Field 'ID' as the first field. This field value will be recorded like an autonumber field.
  • Third parameter 'Keyx' field is where you have the numbers '0005' etc. and this will be suffixed with '001', '002' (0005001, 0005002....) for the number of records duplicated.
  • qty = rst1.Fields("Quantity").Value statement takes the field name 'Quantity' as constant, if yours is different then change it.

Good luck!

Forgot to attach the image of a sample run. It is attached in the next post.
 

apr pillai

AWF VIP
Local time
Today, 06:41
Joined
Jan 20, 2005
Messages
735
Sample Run image is attached.
 

Attachments

  • tableImage.jpg
    tableImage.jpg
    48.6 KB · Views: 73

tt1611

Registered User.
Local time
Yesterday, 21:11
Joined
Jul 17, 2009
Messages
132
Hey Apr
First off thanks for looking into this for me. So after posting this thread, I went back into Access and did something pretty similar to what you had running by opening the specific recordset and creating a loop for multiple inserts where condition qty > 1 was true.

Please see my code below. Maybe your code and mine may help someone in this same predicament later on down the road. Again thanks for many lines of code and testing you did on this for me.

Code:
Private Sub cmdpopulate()
 
Dim rst As DAO.Recordset
Dim strSQL As String
strSQL = "Select * from SQLPBOMasterL ORDER BY Master_Qty"
Set rst = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset, dbSeeChanges)
If rst.RecordCount <> 0 Then
rst.MoveFirst
Do Until rst.EOF
On Error Resume Next
If rst!Master_Qty > 1 Then
For n = 1 To rst!Master_Qty
'then create a loop that goes through each record and creates n amount of records based on the quantity selected
DoCmd.RunSQL "INSERT INTO SQLPBOMaster(Master_Asset_ID, Master_Suffix, Master_StrucID, Master_PropBK,  Master_Qty, Master_Desc, Master_Serial," & _
             "Master_ClassID, Master_AcqDate, Master_AcqCost, Master_CostBasis, Master_Dep, Master_NBV, Master_IC, Master_DV, Master_Print ) VALUES" & _
             "('" & rst!Master_Asset_ID & "' & '00' &  '" & n & "' , '" & rst!Master_Suffix & "' , '" & rst!Master_StrucID & "' , '" & rst!Master_PropBK & "' , " & _
             "'" & rst!Master_Qty & "' , '" & rst!Master_Desc & "' , '" & rst!Master_Serial & "' , '" & rst!Master_ClassID & "' , '" & rst!Master_AcqDate & "', " & _
             "'" & rst!Master_AcqCost & "', '" & rst!Master_CostBasis & "', '" & rst!Master_Dep & "' , '" & rst!Master_NBV & "' , '" & rst!Master_IC & "' , '" & rst!Master_DV & "' ," & _
              "'0')"
Next n
rst.MoveNext
Else
DoCmd.RunSQL "INSERT INTO SQLPBOMaster(Master_Asset_ID, Master_Suffix, Master_StrucID, Master_PropBK,  Master_Qty, Master_Desc, Master_Serial," & _
             "Master_ClassID, Master_AcqDate, Master_AcqCost, Master_CostBasis, Master_Dep, Master_NBV, Master_IC, Master_DV, Master_Print ) VALUES" & _
             "('" & rst!Master_Asset_ID & "', '" & rst!Master_Suffix & "' , '" & rst!Master_StrucID & "' , '" & rst!Master_PropBK & "' , " & _
             "'" & rst!Master_Qty & "' , '" & rst!Master_Desc & "' , '" & rst!Master_Serial & "' , '" & rst!Master_ClassID & "' , '" & rst!Master_AcqDate & "', " & _
             "'" & rst!Master_AcqCost & "', '" & rst!Master_CostBasis & "', '" & rst!Master_Dep & "' , '" & rst!Master_NBV & "' , '" & rst!Master_IC & "' , '" & rst!Master_DV & "' ," & _
              "'0')"
rst.MoveNext
End If
Loop
Else
End If
DoCmd.SetWarnings True
MsgBox "Master List on server is now up to date", vbOKOnly + vbInformation, "Success"
Me.prgbar1.Visible = False
DoCmd.SetWarnings True
End Sub

The above used a temp table SQLPBOMasterL where the initial values from the excel sheet were inserted into by a standard INSERT query and then the second table SQLPBOMaster held all the records duplicate and otherwise from the temp table.

Thanks again men.
 

Users who are viewing this thread

Top Bottom