Excel VBA automation - copy row "x" number of times based on cell value

Question

I'm attempting to automate Excel in a way that will save me countless hours of tedious data entry. Here's my problem.

We need to print barcodes for all of our inventory, which includes 4,000 variants each with a specific quantity.

Shopify is our e-commerce platform and they do not support customized exports; however, can export a CSV of all variants, which includes an inventory count column.

We use Dymo for our barcode printing hardware/software. Dymo will only print one label per row (it ignores the quantity column).

Is there a way to automate excel to duplicate the row "x" number of times based on the value in the inventory column?

Here's a sample of the data:

https://www.evernote.com/shard/s187/sh/b0d5b92a-c5f6-469c-92fb-3d4e03d97544/d176d3448ba0cafbf3d61506402d9e8b/res/254447d2-486d-454f-8871-a0962f03253d/skitch.png

• If Column N = 0, ignore and move to next row
• If Column N > 1, copy current row, "N" number of times (to a separate sheet)

I tried to find someone who had done something similar so that I could modify the code, but after an hour of searching I'm still right where I started. Thank you in advance for the help!

Answer 1

David beat me to it but an alternate approach never hurt anyone.

Consider the following data

Item           Cost Code         Quantity
Fiddlesticks   0.8  22251554787  0
Woozles        1.96 54645641     3
Jarbles        200  158484       4
Yerzegerztits  56.7 494681818    1

With this function

Public Sub CopyData()
    ' This routing will copy rows based on the quantity to a new sheet.
    Dim rngSinglecell As Range
    Dim rngQuantityCells As Range
    Dim intCount As Integer

    ' Set this for the range where the Quantity column exists. This works only if there are no empty cells
    Set rngQuantityCells = Range("D1", Range("D1").End(xlDown))

    For Each rngSinglecell In rngQuantityCells
        ' Check if this cell actually contains a number
        If IsNumeric(rngSinglecell.Value) Then
            ' Check if the number is greater than 0
            If rngSinglecell.Value > 0 Then
                ' Copy this row as many times as .value
                For intCount = 1 To rngSinglecell.Value
                    ' Copy the row into the next emtpy row in sheet2
                    Range(rngSinglecell.Address).EntireRow.Copy Destination:= Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)                                
                    ' The above line finds the next empty row.

                Next
            End If
        End If
    Next
End Sub

Produces the following output on sheet2

Item            Cost    Code        Quantity
Woozles         1.96    54645641    3
Woozles         1.96    54645641    3
Woozles         1.96    54645641    3
Jarbles         200     158484      4
Jarbles         200     158484      4
Jarbles         200     158484      4
Jarbles         200     158484      4
Yerzegerztits   56.7    494681818   1

The caveats with this code is that there can be no empty fields in the Quantity column. I used D so feel free to substitute N for your case.

Answer 2

Should be enough to get you started:

Sub CopyRowsFromColumnN()

Dim rng As Range
Dim r As Range
Dim numberOfCopies As Integer
Dim n As Integer

'## Define a range to represent ALL the data
Set rng = Range("A1", Range("N1").End(xlDown))

'## Iterate each row in that data range
For Each r In rng.Rows
    '## Get the number of copies specified in column 14 ("N")
    numberOfCopies = r.Cells(1, 14).Value

    '## If that number > 1 then make copies on a new sheet
    If numberOfCopies > 1 Then
        '## Add a new sheet
        With Sheets.Add
            '## copy the row and paste repeatedly in this loop
            For n = 1 To numberOfCopies
                r.Copy .Range("A" & n)
            Next
        End With
    End If
Next

End Sub

Answer 3

Might be a bit late to answer, however this could help others. I have tested this solution on Excel 2010. Say: "Sheet1" is the name of the sheet where your data is located and "Sheet2" is the sheet where you want your repeated data. Assuming you have these sheets created, try the below code.

Sub multiplyRowsByCellValue()
Dim rangeInventory As Range
Dim rangeSingleCell As Range
Dim numberOfRepeats As Integer
Dim n As Integer
Dim lastRow As Long

'Set rangeInventory to all of the Inventory Data
Set rangeInventory = Sheets("Sheet1").Range("A2", Sheets("Sheet1").Range("D2").End(xlDown))

'Iterate each row of the Inventory Data
For Each rangeSingleCell In rangeInventory.Rows
    'number of times to be repeated copied from Sheet1 column 4 ("C")
    numberOfRepeats = rangeSingleCell.Cells(1, 3).Value

    'check if numberOfRepeats is greater than 0
    If numberOfRepeats > 0 Then
         With Sheets("Sheet2")
            'copy each invetory item in Sheet1 and paste "numberOfRepeat" times in Sheet2

                For n = 1 To numberOfRepeats 
                lastRow = Sheets("Sheet1").Range("A1048576").End(xlUp).Row
                r.Copy
                Sheets("Sheet1").Range("A" & lastRow + 1).PasteSpecial xlPasteValues
            Next
        End With
    End If
Next

End Sub

This solution is slightly modified version of David Zemens solution.

Answer 4

Resurrecting a WAY old thread here - but I'm getting a "Run-time error '424': Object required" on the "For Each rngSinglecell In rngQuantityCells" line

Sub DupRowssTEST()
Dim CurrentWB As Workbook 
Dim rngSinglecell As Range
Dim rngQuantityCells As Range
Dim intCount As Integer

Set CurrentWB = ActiveWorkbook

Set rngQuantityCellls = Range("B2", Range("B2").End(xlDown))

For Each rngSinglecell In rngQuantityCells
    If IsNumeric(rngSinglecell.Value) Then
        If rngSinglecell.Value > 0 Then
            For intCount = 1 To rngSinglecell.Value
                Range(rngSinglecell.Address).EntireRow.SpecialCells(xlCellTypeVisible).Copy
                    With CurrentWB.Sheets(1).Range("N" & Rows.Count).End(xlUp).Offset(1)
                        .PasteSpecial xlPasteValues
                        .PasteSpecial xlPasteFormats
                    End With
            Next
        End If
    End If
Next rngSinglecell

End Sub

It seems perhaps because I didn't further set 'rngSinglecell', but I assumed since it was dimmed as a range it would be assummed?

Any thoughts on this would be greatly appreciated!