need to expand the data so that each row of data copies dependant upon the quantity required in column 6

Hi I'm using Excel 2016, and I have a file with 6 columns. In the 6th column I have a value ranging from 1-11. I need to expand the data so that each row of data copies dependant upon  the quantity required in column 6. I've been told that I need to use VBA but I've never used this, so if there is a script that would do what I need to do, could you also give instructions on how to enter it please.
sampledata.xlsx
Tim JonesAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Donald YatesCommented:
Need a clarification.  You want each row to be duplicated according to the value in qty?  Each row would have a qty = 1?
Tim JonesAuthor Commented:
If the original qty is 1 I don't need it duplicating, but if the qty was 2,3,4,5,6 etc then I need each row replicating 2,3,4,5,6 times. Hope I'm making sense?
Donald YatesCommented:
Yep. No biggy.  I write a vba  macro tomorrow that will do it.
IT Pros Agree: AI and Machine Learning Key

We’d all like to think our company’s data is well protected, but when you ask IT professionals they admit the data probably is not as safe as it could be.

Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
You may try something like this...
In the attached, click the button called "Replicate Rows" to get the desired output.
Sub ReplicateRows()
Dim lr As Long, lc As Long, i As Long, n As Long

Application.ScreenUpdating = False

lr = ActiveSheet.UsedRange.Rows.Count
lc = ActiveSheet.UsedRange.Columns.Count

For i = lr To 2 Step -1
    If IsNumeric(Cells(i, "F")) And Cells(i, "F") > 1 Then
        n = Cells(i, "F")
        Range(Cells(i, 1), Cells(i, lc)).Copy
        Range("A" & i + 1).Resize(n).Insert shift:=xlDown
        Application.CutCopyMode = 0
    End If
Next i
Application.ScreenUpdating = True
End Sub

Open in new window

ReplicateRows.xlsm
Donald YatesCommented:
The code segment below will product the following output:

BG2150      (BG2150) BRAKE DIS      DSK136      APEDSK136      BRAKE DISC (PACK OF 2)      1
BG2213      (BG2213) BRAKE DIS      DSK182      APEDSK182      BRAKE DISC (PACK OF 2)      1
BG2217      (BG2217) BRAKE DIS      DSK179      APEDSK179      BRAKE DISC (PACK OF 2)      1
BG2282      (BG2282) BRAKE DIS      DSK199      APEDSK199      BRAKE DISC (PACK OF 2)      1
BG2282      (BG2282) BRAKE DIS      DSK199      APEDSK199      BRAKE DISC (PACK OF 2)      1
BG2282      (BG2282) BRAKE DIS      DSK199      APEDSK199      BRAKE DISC (PACK OF 2)      1
BG2297      (BG2297) BRAKE DIS      DSK908      APEDSK908      BRAKE DISC (PACK OF 2)      1
BG2297      (BG2297) BRAKE DIS      DSK908      APEDSK908      BRAKE DISC (PACK OF 2)      1
BG2387      (BG2387) BRAKE DIS      DSK519      APEDSK519      BRAKE DISC (PACK OF 2)      1
BG2440      (BG2440) BRAKE DIS      DSK208      APEDSK208      BRAKE DISC (PACK OF 2)      1
BG2440      (BG2440) BRAKE DIS      DSK208      APEDSK208      BRAKE DISC (PACK OF 2)      1
BG2440      (BG2440) BRAKE DIS      DSK208      APEDSK208      BRAKE DISC (PACK OF 2)      1
BG2443      (BG2443) BRAKE DIS      DSK518      APEDSK518      BRAKE DISC (PACK OF 2)      1

To use it, click Developer -> Macros -> Record.   Macro Name is anything you want. Click OK

Immediately click "Stop Recording" (Top Left Blue square).
Click Developer >Macros  Click on the Macro you just recorded. Click edit

Paste the code below in the blank space.  To run the macro, click Developer>macro.  Click on your macro name.  Click run.
This code is not professional.  It has no safeties, error catching or other stuff.  There's a dozen ways it could bomb off.  DO NOT run it on a working spreadsheet.  

Dim wsIn As Worksheet
    Dim wsOut As Worksheet
    Set wsIn = Sheets("Sheet1")
    Set wsOut = Sheets.Add(After:=Sheets(Worksheets.Count))
   
    myROw = 2 ' Skiping headers
    outRow = 1
   
    Do
        PtNum = wsIn.Cells(myROw, 1)
        Qty = wsIn.Cells(myROw, 6)
   
        For n = 1 To Val(Qty)
            wsIn.Rows(myROw).EntireRow.Copy
            wsOut.Cells(outRow, 1).Select
            wsOut.Paste
            wsOut.Cells(outRow, 6) = 1
            outRow = outRow + 1
        Next n
        myROw = myROw + 1
       
     Loop Until PtNum = ""

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Rob HensonFinance AnalystCommented:
I was asked by a colleague for something similar and came up with a non-vba solution which you may be able to modify for your purpose.

See attached, the relevant formula for duplicating the part numbers is in column K, after copying the first part number into row 2. Columns L to O are then just VLOOKUP from the table based on the part number. For a larger dataset you just need to copy the formulas down enough rows until the formula in column K returns a value of zero, the number of rows will the be the total of the quantity column.

Thanks
Rob
sampledata.xlsx
Rob HensonFinance AnalystCommented:
Author didn't specify that the solution worked so maybe worth sharing across other solutions.
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
The chosen answers resolved the question.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Office

From novice to tech pro — start learning today.