Split one row with a value into multiple lines to add up to this value

[Puffcio]

Hello,

I am having a trouble solving an issue that i am having with excel.

I have a label printing software which will feed a data from excel spread sheet template. What i don't know is if there is any way of splitting below example:

I have a product which is being send to customer and its being saved in one file:

Product	Product Description	Pieces / Packer	Pieces Picked
123456	Description	20	100

However i need this to be feeded into the template as below:

Product	Product Description	Pieces / Packer	Packer Number	Total Packers	Packer Qty
123456	Description	20	1	5	20
123456	Description	20	2	5	20
123456	Description	20	3	5	20
123456	Description	20	4	5	20
123456	Description	20	5	5	20

There will be a lot of lines so i was looking to avoid manual actions hoping that there will be some easier solutions available.

Could someone point me to the right direction if posisble?

Thank you

 

[I_know_nuffin]

try the below

in a new workbook add the original data into a tab called Products
add another tab called Printer

run the below and it should split Products to Printer as per your spec

Sub splitlabels()

Dim rowcount As Long, x As Long, y As Long
Dim Productno As String, desc As String
Dim piecesperpacker As Long, piecespicked As Long, totalpackets As Long
Dim splitcount As Long
Dim productarr(4) As String
Dim splitarr() As String
Dim newrowcounter As Long, newrow As Long, arrcount As Long, loopcounter As Long
Dim wk_input As Worksheet, wk_output As Worksheet

Set wk_input = Sheets("Products") ' the original sheet of products
Set wk_output = Sheets("Printer") ' the new formated list of products

newrowcounter = 2

wk_input.Activate
    ' find the total rows of data
    wk_input.Range("A2").Select
    If ActiveCell.Value = "" Then Exit Sub
    Selection.End(xlDown).Select
    rowcount = ActiveCell.Row
    
    ' for each product row
    For x = 2 To rowcount
    wk_input.Activate
    Productno = wk_input.Range("A" & x).Value
    desc = wk_input.Range("B" & x).Value
    piecesperpacker = wk_input.Range("C" & x).Value
    piecespicked = wk_input.Range("D" & x).Value
    totalpackets = piecespicked / piecesperpacker
    
    ReDim splitarr(1 To totalpackets, 1 To 6)
    For y = 1 To totalpackets
    splitarr(y, 1) = Productno
    splitarr(y, 2) = desc
    splitarr(y, 3) = piecesperpacker
    splitarr(y, 4) = y
    splitarr(y, 5) = totalpackets
    splitarr(y, 6) = piecesperpacker
    Next y
    
    loopcounter = 0
    wk_output.Activate
    ' for each new packing row
    For newrow = newrowcounter To newrowcounter + (y - 2)
    loopcounter = loopcounter + 1
    ' for each element of the array
     For arrcount = 1 To 6
       wk_output.Cells(newrow, arrcount) = splitarr(loopcounter, arrcount)
     Next arrcount
     
    Next newrow
    newrowcounter = newrowcounter + (y - 1)
    Next x
    
End Sub

 

[Puffcio]

Thats amazing, thank you

 

[I_know_nuffin]

Glad it worked for you