# Seperate line per quantity ordered

#### ccameronn

##### New Member
Hi all,

First time posting on here so please let me know if you need any additional info from what I provide.

In short, I am trying to to acheive the following:

The excel file needs to be transformed into:

Here are screen shots of how the file is currently presented:

The highlighted columns are those that need to be payed attention to, for example in Z7 there has been 2 of the same product ordered. This needs to be ammended to 2 lines with the quantity being '1' for each. The rest of the data in the line should be same. Below is an example of how I would like the result to be:

As you can see the line has in effect been copy and pasted, however the quantity has changed to 1 for each line. Just for clarification, this could be the case for any one of the cells within column 'Z', it all depends on whether more than one of the same product has been ordered.

Hopefully this is well undertsood and you guys can help me out! I really appreciate you having a look.

Many thanks

### Excel Facts

What is the last column in Excel?
Excel columns run from A to Z, AA to AZ, AAA to XFD. The last column is XFD.

#### Crystalyzer

##### Well-known Member
I think this will do what you want. Please test on a copy of your workbook.

VBA Code:
``````Sub RepeatRows()

Dim i  As Long
Dim j As Long
Dim k As Long
Dim q as Long

i = 2
k = Cells(Rows.Count, 26).End(xlUp).Row

While i <= k
q = Cells(i, 26).Value
If q > 1 Then
Cells(i, 26).EntireRow.Copy
Range(Cells(i, 26), Cells(i + q - 2, 26)).EntireRow.Insert Shift:=xlDown
For j = 0 To q - 1
Cells(i + j, 26).Value = 1
Next j
Application.CutCopyMode = False
'Next j
End If
i = i + 1
k = k + q - 1
Wend
End Sub``````

#### ccameronn

##### New Member
I think this will do what you want. Please test on a copy of your workbook.

VBA Code:
``````Sub RepeatRows()

Dim i  As Long
Dim j As Long
Dim k As Long
Dim q as Long

i = 2
k = Cells(Rows.Count, 26).End(xlUp).Row

While i <= k
q = Cells(i, 26).Value
If q > 1 Then
Cells(i, 26).EntireRow.Copy
Range(Cells(i, 26), Cells(i + q - 2, 26)).EntireRow.Insert Shift:=xlDown
For j = 0 To q - 1
Cells(i + j, 26).Value = 1
Next j
Application.CutCopyMode = False
'Next j
End If
i = i + 1
k = k + q - 1
Wend
End Sub``````
Hi there,

That is almost perfect, thank you very much for taking the time to look into this.

Apologies I should have mentioned this my original post, but sometimes we may have in excess of 50 rows on these spreadhsheets. Meaning that when I run this code, the first maybe 12 rows work great but anything past that isn't affected. Hopefully it is a simple update to the code you have already given me to solve this!

Many thanks,

Cam

#### Crystalyzer

##### Well-known Member
I anticipated that and the line of code below is supposed to increment so that when rows are inserted it accounts for the increase in the number of rows to process.

k = k + q - 1

I have tested this with up to 100 rows and it works.

#### Crystalyzer

##### Well-known Member
If you are still having trouble, please post your worksheet data using XL2BB tool (see signature for link to instructions)

#### ccameronn

##### New Member
If you are still having trouble, please post your worksheet data using XL2BB tool (see signature for link to instructions)
Hi again,

Thank you for the link, below is the mini sheet:

15 july 2021 15h52.csv
1Customer codeCustomer referenceName receiver(Cell) phone numberThird line addressAddressYesCityCountryAddress numberAdd on addressEAN Number receiving addressOrder dateShipment dateDelivery termsInternal logistical information field 1Internal logistical information field 2External logistical information field 1External logistical information field 2Reference origin orderCarrierLine numberEAN Number of packsizeItem numberBerekend bedragQuantity in piecesItem number of customerDescription of customerSpecifications of customerEmail addressBatch numberSeperate orderDealer
2
15 july 2021 15h52

This is the spreadsheet before running the macro, if you test it you will see that the last row (17) still shows that the quantity = 2.

The issue could be to do with the format of the spreadsheet that I have provided, however I am unable to spot the discrepancy.

Many thanks

#### Crystalyzer

##### Well-known Member
ok, I didn't account for a blank row in row 2 in my code. I have updated it and it is below. Running this code on your source data above works for every row and does not skip any or stop processing.

VBA Code:
``````Sub RepeatRows()
Dim i  As Long
Dim j As Long
Dim k As Long

i = 2
k = Cells(Rows.Count, 26).End(xlUp).Row

While i <= k
q = Cells(i, 26).Value
If q > 1 Then
Cells(i, 26).EntireRow.Copy
Range(Cells(i, 26), Cells(i + q - 2, 26)).EntireRow.Insert Shift:=xlDown
For j = 0 To q - 1
Cells(i + j, 26).Value = 1
Next j
Application.CutCopyMode = False
End If
i = i + 1
If q <> 0 Then k = k + q - 1
Wend
End Sub``````

#### ccameronn

##### New Member
ok, I didn't account for a blank row in row 2 in my code. I have updated it and it is below. Running this code on your source data above works for every row and does not skip any or stop processing.

VBA Code:
``````Sub RepeatRows()
Dim i  As Long
Dim j As Long
Dim k As Long

i = 2
k = Cells(Rows.Count, 26).End(xlUp).Row

While i <= k
q = Cells(i, 26).Value
If q > 1 Then
Cells(i, 26).EntireRow.Copy
Range(Cells(i, 26), Cells(i + q - 2, 26)).EntireRow.Insert Shift:=xlDown
For j = 0 To q - 1
Cells(i + j, 26).Value = 1
Next j
Application.CutCopyMode = False
End If
i = i + 1
If q <> 0 Then k = k + q - 1
Wend
End Sub``````
Absolutely spot on. Thank you again for your help, it works perfectly.

Cam

Replies
4
Views
528
Replies
2
Views
79
Replies
0
Views
162
Replies
1
Views
193
Replies
21
Views
390

1,191,177
Messages
5,985,137
Members
439,941
Latest member
robertv13

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back