[SOLVED] How to repeat values X times based on a cell value

How to repeat values X times based on a cell value

Each row of item number, pack, and size is to be repeated multiple times in a separate sheet based on the number in the column "number of labels".

Note: The number in the number of labels is for test purposes and does not need to increment.

Sheet 1 would be as follows

Item #  Pack    Size    Number of Labels
12545   20      1.8oz   1
56010   6       4PK     2
70091   6       7oz     3
61816   24      1.6oz   4

I would like sheet 2 to output the following:

Item #  Pack    Size
12545   20      1.8oz
56010   6        4PK
56010   6        4PK
70091   6        7oz
70091   6        7oz
70091   6        7oz
61816   24       1.6oz
61816   24       1.6oz
61816   24       1.6oz
61816   24       1.6oz

I found the following code from https://www.extendoffice.com/documents/excel/1897-excel-repeat-cell-value-x-times.html#a2 to output multiple columns. I want the cell input ranges to be fixed and to not use the dialog boxes.

Sub CopyData()
'Update 20140724
Dim Rng As Range
Dim InputRng As Range, OutRng As Range
xTitleId = "KutoolsforExcel"
Set InputRng = Application.Selection
Set InputRng = Application.InputBox("Range :", xTitleId, InputRng.Address, Type:=8)
Set OutRng = Application.InputBox("Out put to (single cell):", xTitleId, Type:=8)
Set OutRng = OutRng.Range("A1")
For Each Rng In InputRng.Rows
    xValue = Rng.Range("A1").Value
    xNum = Rng.Range("B1").Value
    OutRng.Resize(xNum, 1).Value = xValue
    Set OutRng = OutRng.Offset(xNum, 0)
Next
End Sub

Context: I have to create many labels for new products. I manually type each label in Word. I found that I could use Word's Mail merge operation to import Excel data. I have those parts working but now I need to get the exact number of labels for each item.

Solution

Private Sub hereyago()

    Dim arr As Variant
    Dim wsO As Worksheet
    Dim this As Integer

    arr = ThisWorkbook.Sheets("Sheet1").UsedRange
    Set wsO = ThisWorkbook.Sheets("Sheet2")

    For i = LBound(arr, 1) To UBound(arr, 1)
        If IsNumeric(arr(i, 4)) Then
            this = arr(i, 4)
            For h = 1 To this
                wsO.Cells(wsO.Rows.count, 1).End(xlUp).Offset(1, 0).Value = arr(i, 1)
                wsO.Cells(wsO.Rows.count, 1).End(xlUp).Offset(0, 1).Value = arr(i, 2)
                wsO.Cells(wsO.Rows.count, 1).End(xlUp).Offset(0, 2).Value = arr(i, 3)
                wsO.Cells(wsO.Rows.count, 1).End(xlUp).Offset(0, 3).Value = arr(i, 4)
            Next h
        End If
    Next i
End Sub