Duplicate rows based on cell value 1

[cdiwindows]

I need to duplicate the number of rows based on the number in one of the cells in a row. We have a contest that if they sell so many items, they get an entry in a drawing. I want to create a row for each possible entry. How can I loop through the rows on the left to create the rows on the right?

EmpID Entries EmpID Entries
103 4 103 4
109 5 103 4
111 4 103 4
112 1 103 4
122 2 109 5
124 4 109 5
109 5
109 5
109 5
111 4
111 4
111 4
111 4
112 1
122 2
122 2

 

[firefytr]

Hi there,

Maybe something like this ...

Sub DuplicateRowsPlease()
    Dim c As Range, rngLoop As Range, i As Long
    Set rngLoop = Range("A2", Cells(Rows.Count, 1).End(xlUp))
    For Each c In rngLoop
        For i = 1 To CLng(c.Offset(0, 1).Value)
            Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Value = c.Value
            Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).Value = c.Offset(0, 1).Value
        Next i
    Next c
End Sub

-----------
Regards,
Zack Barresse

 

[cdiwindows]

Thank you firefytr! Worked perfectly.