Copy rows based on field value (1 Viewer)

[MJT]

I have only have basic levels of Access and VBA and hence have spent hours trying to find a solution in VBA to my issue and was hoping someone might be able to shed any light on how this can be achieved or have any sample code.

I have a table that contains rows of items with a quantity in the final field. ie

Item_name, Size, Colour, Quantity
T-Shirt, Large, Grey, 2
T-shirt, Small, Black, 3

I need the rows to be copied the same number of times as the quantity value so that instead of having 1 row with a quantity of 3, it copies this row a further 2 times so that there are 3 rows for each item ie

Item_name, Size, Colour, Quantity
T-shirt, Large, Grey, 2
T-shirt, Large, Grey, 2
T-shirt, Small, Black, 3
T-shirt, Small, Black, 3
T-shirt, Small, Black, 3

Does anyone have any ideas?

Many thanks in advance.

 

[dcb]

Open a recordset of the table
For each record where Quantity > 1
Create a loop based on (quantity - 1)
Insert into the table
Alter the original record to 1
move to next record

 

[MJT]

Thanks dcb but I don't get the

Insert into the table
Alter the original record to 1

what do you mean?, can you give me a bit more info. Thanks again for the help.

 

[vbaInet]

What are your intentions for wanting to duplicate information? Maybe we could advise on a different strategy?

Am I correct to assume you've never used or (probably heard of) a recordset before?

 

[dcb]

I assume you are trying to alter the same table that has the data in it?

If you have:
T-shirt, Small, Black, 3
You want ????
T-shirt, Small, Black, 1
T-shirt, Small, Black, 1
T-shirt, Small, Black, 1

Is this correct?

 

[MJT]

hey dcb

Yes that's correct.

 

[dcb]

Open a recordset of the table
For each record where Quantity > 1
Create a loop based on (quantity - 1)
Insert into the table
** Insert into yourtable (c1,c2,c3,c4) values("Tshirt","Big","Blue",1);
Alter the original record to 1
** Update yourtable set c4 = 1 where you pk = something;
move to next record

As vbaInet asked - have you worked with recordsets?

 

[vbaInet]

Try this code (using dcb's suggestions), it compiles but it hasn't been tested. BACKUP before using this code and try it on a copy of your table first. Change "NameOfTable" to the name of your table:

    Dim yRow As Long, i As Long, j As Long, rstClone As Recordset
    Dim tempItemName As String, tempSize As String, tempColour As String, tempQuantity As Variant

    Set rstClone = CurrentDb.OpenRecordset("NameOfTable").Clone

    With rstClone
        If .BOF = False Then
            If MsgBox("Backup your table before continuing" & vbCrLf & "Continue?", vbYesNo) = vbYes Then
                ' Fill the recordset
                .MoveLast
                .MoveFirst
                For yRow = 0 To .RecordCount - 1
                    If (!Quantity & "") <> "" Then
                        If Val(!Quantity) > 1 Then
                            ' Copy the values
                            tempItemName = !Item_name
                            tempSize = !Size
                            tempColour = !Colour
                            .Edit ' Change quantity to 1
                            !Quantity = 1
                            .Update     ' Save
                            
                            ' Duplicate the item(s)
                            For i = 1 To Val(!Quantity)
                                .AddNew
                                !Item_name = tempItemName
                                !Size = tempSize
                                !Colour = tempColour
                                !Quantity = 1
                                .Update
                                .Bookmark = .LastModified
                            Next
                        End If
                    End If
                    .MoveNext
                Next
                MsgBox "Finished updating."
            End If
        Else
            MsgBox "There are no records"
        End If
    End With

Enjoy.

 

[dcb]

vbaInet - Your Loop Quantity is being read after your update [from what i can see] thus the loop will not run (=1)

 

[vbaInet]

Oooh... correct dcb. I just quickly bashed it out.

Change the following

[COLOR=Red]                            tempQuantity = !Quantity[/COLOR]
                            .Edit ' Change quantity
                            !Quantity = 1
                            .Update     ' Save
                            
                            ' Duplicate the item(s)
[COLOR=Red]                            For i = 1 To Val(tempQuantity)[/COLOR]

 

[MJT]

vbaInet/dcb

Thanks for all the help, I've been trying to work this out for so long. I've taken your example but I'm getting a Run time error 3021 error

No current record

at line

If (!products_stock_quantity & "") <> "" Then


all my code is below, do you have any ideas?

Dim yRow As Long, i As Long, j As Long, rstClone As Recordset
Dim tempbarcode As String, tempv_products_name_1 As String, tempPrice As String, tempv_products_id As String, tempproducts_stock_id As String, tempproducts_stock_attributes As String, tempExpr1 As String, tempShoe_Size2 As String, tempproducts_stock_quantity As Variant

Set rstClone = CurrentDb.OpenRecordset("barcodes to print").Clone

With rstClone
If .BOF = False Then
If MsgBox("Backup your table before continuing" & vbCrLf & "Continue?", vbYesNo) = vbYes Then
' Fill the recordset
.MoveLast
.MoveFirst
For yRow = 0 To .RecordCount - 1

If (!products_stock_quantity & "") <> "" Then
If Val(!products_stock_quantity) > 1 Then
' Copy the values
tempbarcode = !barcode
tempv_products_name_1 = !v_products_name_1
tempPrice = !Price
tempv_products_id = !v_products_id
tempproducts_stock_id = !products_stock_id
tempproducts_stock_attributes = !products_stock_attributes
tempExpr1 = !Expr1
tempShoe_Size2 = !Shoe_Size2
tempproducts_stock_quantity = !products_stock_quantity
.Edit ' Change products_stock_quantity
!products_stock_quantity = 1
.Update ' Save

' Duplicate the item(s)
For i = 1 To Val(tempproducts_stock_quantity)
.AddNew
!barcode = tempbarcode
!v_products_name_1 = tempv_products_name_1
!Price = tempPrice
!v_products_id = tempv_products_id
!products_stock_id = tempproducts_stock_id
!products_stock_attributes = tempproducts_stock_attributes
!Expr1 = tempExpr1
!Shoe_Size2 = tempShoe_Size2
!products_stock_quantity = 1
.Update
.Bookmark = .LastModified
Next
End If
End If
.MoveNext
Next
MsgBox "Finished updating."
End If
Else
MsgBox "There are no records"
End If
End With

 

[dcb]

Try
If (Nz(!products_stock_quantity,"") & "") <> "" Then