VBA - Excel Coding Auto Adding Rows

Question

wondering if there is a VBA I could use to automatically add rows after data based on a cells value. 

based on the value in column F, I want to add that many blank lines after each row... For Row 9, F9 has a value of 6, so I'd like 6 blank rows. Ideally I'd like the VBA to be a button, I can click, I know how to create the button, just need help with the coding. 

Any help would be greatly appreciated. 

Thank you

Answer 1

Clearly, you are not allowed to include something in your posts ;)   

If you want to copy specific information from the row into the new rows, you can try code like this, which will copy the values from columns A:C and G:M into the new rows:

Sub AddRowsBasedOnColumnF()

    Dim lngR As Long

    For lngR = Cells(Rows.Count, "F").End(xlUp).Row To 2 Step -1

        If IsNumeric(Cells(lngR, "F").Value) Then

            Rows(lngR + 1).Resize(Cells(lngR, "F").Value).Insert

            Intersect(Rows(lngR + 1).Resize(Cells(lngR, "F").Value), Range("A:C")).Value = Intersect(Rows(lngR), Range("A:C")).Value

            Intersect(Rows(lngR + 1).Resize(Cells(lngR, "F").Value), Range("G:M")).Value = Intersect(Rows(lngR), Range("G:M")).Value

        End If

    Next lngR

End Sub

Answer 2

To start with my sheet looks like such: 

The code still works, i just get the error message and the results of the code are: 

I can live with the error message, since code still works. 

one last help, would it be possible to have it copy the item # into the rows it adds at the same time? 

So I get the following: 

Thanks for your help in advance!!!!

Answer 3

The only possibility for errors that I can think of are:

1. the sheet is protected
2. the sheet is completely filled
3. the numbers are so large that you try to insert over a million rows in total

Try unprotecting the sheet and making sure that you have small numbers in column F and running the code again.

Answer 4

I am getting this error:

Answer 5

Assign this macro to your button

Sub AddBlankRowsBasedOnColumnF()

    Dim lngR As Long

    For lngR = Cells(Rows.Count, "F").End(xlUp).Row To 2 Step -1

        If IsNumeric(Cells(lngR, "F").Value) Then

            Rows(lngR + 1).Resize(Cells(lngR, "F").Value).Insert

        End If

    Next lngR

End Sub