Macro - copy and insert rows of data based on value in one column

[lcmast401]

I have read many posts similar to this but can't get my vba code to work. Please help.
Sample data:

[TABLE="width: 963"]
<tbody>[TR]
[TD="align: right"]A1[/TD]
[TD]A2[/TD]
[TD="align: right"]A3[/TD]
[TD]A4[/TD]
[TD="align: right"]A5[/TD]
[TD]A6A7[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
[TABLE="width: 963"]
<colgroup><col><col><col><col><col><col><col></colgroup><tbody>[TR]
[TD="align: right"]21609[/TD]
[TD]Gold [/TD]
[TD="align: right"]$10[/TD]
[TD]Person1[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]$10[/TD]
[TD]Raffle1[/TD]
[/TR]
[TR]
[TD="align: right"]21609[/TD]
[TD]Gold [/TD]
[TD="align: right"]$10[/TD]
[TD]Person2[/TD]
[TD="align: right"]9[/TD]
[TD="align: right"]$90[/TD]
[TD]Raffle1[/TD]
[/TR]
[TR]
[TD="align: right"]21609[/TD]
[TD]Gold [/TD]
[TD="align: right"]$10[/TD]
[TD]Person3[/TD]
[TD="align: right"]6[/TD]
[TD="align: right"]$60[/TD]
[TD]Raffle1[/TD]
[/TR]
[TR]
[TD="align: right"]

​

[/TD]
[TD][/TD]
[TD="align: right"][/TD]
[TD][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD]


[/TD]
[/TR]
</tbody>[/TABLE]
Based on the value in a5 - if it is greater than 1, I want it to copy and insert the same line x-1 times. For example in the second line, the value in a5 is 9, so i would like to see that exact line 8 addition times, or 9 times in total. For person3, where the value is 6, I would like to see that line 6 times in total, etc.

Thank you for the help!

 

[Fluff]

Hi & welcome to MrExcel.
How about

Sub lcmast401()
   Dim i As Long
   
   For i = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
      If Cells(i, 5) > 1 Then
         Rows(i).Copy
         Rows(i + 1).Resize(Cells(i, 5) - 1).Insert
      End If
   Next i
   Application.CutCopyMode = False
End Sub

 

[lcmast401]

Thank you!!! That worked perfectly!

Hi & welcome to MrExcel.
How about

Sub lcmast401()
   Dim i As Long
   
   For i = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
      If Cells(i, 5) > 1 Then
         Rows(i).Copy
         Rows(i + 1).Resize(Cells(i, 5) - 1).Insert
      End If
   Next i
   Application.CutCopyMode = False
End Sub

 

[lcmast401]

I wish I understood it better so that I could create my own in the future!

 

[Fluff]

You're welcome & thanks for the feedback.
I've added some comments, that may help you to understand it.

Sub lcmast401()
   Dim i As Long
   
   For i = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1 ' loops through the data starting at the last row & working up
      If Cells(i, 5) > 1 Then 'checks to see if the value in col E for that row is greater then 1
         Rows(i).Copy ' copies the row
         Rows(i + 1).Resize(Cells(i, 5) - 1).Insert 'inserts the copied row x amount of times (determined by the value in col E)
      End If
   Next i
   Application.CutCopyMode = False
End Sub

 

[lcmast401]

Thank you again!

You're welcome & thanks for the feedback.
I've added some comments, that may help you to understand it.

Sub lcmast401()
   Dim i As Long
   
   For i = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1 ' loops through the data starting at the last row & working up
      If Cells(i, 5) > 1 Then 'checks to see if the value in col E for that row is greater then 1
         Rows(i).Copy ' copies the row
         Rows(i + 1).Resize(Cells(i, 5) - 1).Insert 'inserts the copied row x amount of times (determined by the value in col E)
      End If
   Next i
   Application.CutCopyMode = False
End Sub

 

[Fluff]

You're welcome