Seperate line per quantity ordered

ccameronn

New Member
Joined
Jul 21, 2021
Messages
4
Office Version
  1. 2013
Platform
  1. Windows
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:


Customer ABC, Address 1, Address 2, Address 3, Town, Postcode, Product Code, Description, Qty = 3


The excel file needs to be transformed into:


Customer ABC, Address 1, Address 2, Address 3, Town, Postcode, Product Code, Description, Qty = 1

Customer ABC, Address 1, Address 2, Address 3, Town, Postcode, Product Code, Description, Qty = 1

Customer ABC, Address 1, Address 2, Address 3, Town, Postcode, Product Code, Description, Qty = 1


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


mrexcelproject1.png


mrexcelproject2.png


mrexcelproject3.png


mrexcelproject4.png


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:

mrexcelproject5.png


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

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".

Crystalyzer

Well-known Member
Joined
Oct 18, 2011
Messages
688
Office Version
  1. 365
Platform
  1. Windows
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
Joined
Jul 21, 2021
Messages
4
Office Version
  1. 2013
Platform
  1. Windows
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
Joined
Oct 18, 2011
Messages
688
Office Version
  1. 365
Platform
  1. Windows
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
Joined
Oct 18, 2011
Messages
688
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

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

ccameronn

New Member
Joined
Jul 21, 2021
Messages
4
Office Version
  1. 2013
Platform
  1. Windows
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
ABCDEFGHIJKLMNOPQRSTUVWXYZAAABACADAEAFAG
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
3236O3100385CustName1SecondAddLine1PTSCD1City1GB130721150721FRRef11300018.72E+123020RF00032cust@example.co.uk1
4236O3100402CustName2SecondAddLine2PTSCD2City2GB150721150721DAPRef21300024.06E+124.06E+121cust@example.co.uk2
5236O3100402CustName3SecondAddLine3PTSCD3City3GB150721150721DAPRef31300018.72E+122010RM00131cust@example.co.uk2
6236O3100405CustName4SecondAddLine4PTSCD4City4GB150721150721FRRef41300014.06E+124.06E+121cust@example.co.uk1
7236O3100405CustName5SecondAddLine5PTSCD5City5GB150721150721FRRef51300024.06E+124.06E+121cust@example.co.uk1
8236O3100406CustName6SecondAddLine6PTSCD6City6GB150721150721DAPRef620035918.72E+123010RF00121cust@example.co.uk2
9236O3100408CustName7SecondAddLine7PTSCD7City7GB150721150721DAPRef720035924.06E+124.06E+121cust@example.co.uk2
10236O3100408CustName8SecondAddLine8PTSCD8City8GB150721150721DAPRef820035914.06E+124.06E+121cust@example.co.uk2
11236O3100409CustName9FirstAddLine1SecondAddLine9PTSCD9City9GB150721150721DAPRef920035918.72E+122010RM00121cust@example.co.uk2
12236O3100410CustName10SecondAddLine10PTSCD10City10GB150721150721FRRef101300018.72E+122010RM00111cust@example.co.uk2
13236O3100416CustName11SecondAddLine11PTSCD11City11GB150721150721FRRef111300028.72E+122010RM00102cust@example.co.uk2
14236O3100416CustName12SecondAddLine12PTSCD12City12GB150721150721FRRef121300038.72E+122010RM00122cust@example.co.uk2
15236O3100416CustName13SecondAddLine13PTSCD13City13GB150721150721FRRef131300044.06E+124.06E+121cust@example.co.uk2
16236O3100416CustName14SecondAddLine14PTSCD14City14GB150721150721FRRef141300014.06E+124.06E+121cust@example.co.uk2
17236O3100416CustName15SecondAddLine15PTSCD15City15GB150721150721FRRef151300054.06E+124.06E+122cust@example.co.uk2
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
Joined
Oct 18, 2011
Messages
688
Office Version
  1. 365
Platform
  1. Windows
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
 
Solution

ccameronn

New Member
Joined
Jul 21, 2021
Messages
4
Office Version
  1. 2013
Platform
  1. Windows
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
 

Forum statistics

Threads
1,147,474
Messages
5,741,341
Members
423,656
Latest member
Medrok2021

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.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

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

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

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
Top