CREATE NEW ROWS BASED ON CELL VALUE

[amit96]

Hello everyone

I'm trying to write in VBA a code that will do:

1. Take a cell value in column K (there is a number there) and according to this number open new rows below the row I am on and copy the data from the first row to all the other rows that have been opened.

Example -
If in column K9 the number 5 appears, then open 5 new rows below, and copy all the data from row K9 to all the new rows created.
If in position K10 the number 7 appears, then open 5 new rows below, and copy all the data from row K10 to all the new rows created.

 

[My Aswer Is This]

Do you want the script to run when you enter a number in column K or when you click a button?

 

[amit96]

when enter a number in column K

 

[amit96]

when enter a number in column K

In fact column K has a LIST in each row, and inside the LIST there is a list of numbers.
So if you choose 4, they will open 4 rows.
And so on

 

[My Aswer Is This]

I assume you mean insert new rows.
Your subject title says Create but then you say Open.
Try this:
This is an auto sheet event script
Your Workbook must be Macro enabled
To install this code:
Right-click on the sheet tab
Select View Code from the pop-up context menu
Paste the code in the VBA edit window

Private Sub Worksheet_Change(ByVal Target As Range)
'Modified  3/19/2022  6:19:43 AM  EDT
If Target.Column = 11 Then
If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub
Rows(Target.Row).Offset(1).Resize(Target.Value).Insert
Rows(Target.Row).Offset(1).Resize(Target.Value).Value = Rows(Target.Row).Value
End If
End Sub

 

[amit96]

I assume you mean insert new rows.
Your subject title says Create but then you say Open.
Try this:
This is an auto sheet event script
Your Workbook must be Macro enabled
To install this code:
Right-click on the sheet tab
Select View Code from the pop-up context menu
Paste the code in the VBA edit window

Private Sub Worksheet_Change(ByVal Target As Range)
'Modified  3/19/2022  6:19:43 AM  EDT
If Target.Column = 11 Then
If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub
Rows(Target.Row).Offset(1).Resize(Target.Value).Insert
Rows(Target.Row).Offset(1).Resize(Target.Value).Value = Rows(Target.Row).Value
End If
End Sub

Hi!
It worked but there is one problem.
The paste in the new lines is done in values and not in formulas.
I need the paste to be in the formulas.
And if that's possible, I'll really appreciate it if the code would color the new lines gray.

Really thanks for the help it helps me a lot!

 

[My Aswer Is This]

This is beyond my knowledgebase.
I will continue to monitor this thread to see what I can learn.
Copying rows with formulas and then doing what you want is something I'm not sure how to do.

 

[My Aswer Is This]

Try this:
Not sure if your formulas will provide the results you want:

Private Sub Worksheet_Change(ByVal Target As Range)
'Modified  3/20/2022  4:31:57 AM  EDT
If Target.Column = 11 Then
If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub
Rows(Target.Row).Copy
Rows(Target.Row).Offset(1).Resize(Target.Value).Insert
Rows(Target.Row).Offset(1).Resize(Target.Value).PasteSpecial
Application.CutCopyMode = False

End If
End Sub

 

[amit96]

Try this:
Not sure if your formulas will provide the results you want:

Private Sub Worksheet_Change(ByVal Target As Range)
'Modified  3/20/2022  4:31:57 AM  EDT
If Target.Column = 11 Then
If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub
Rows(Target.Row).Copy
Rows(Target.Row).Offset(1).Resize(Target.Value).Insert
Rows(Target.Row).Offset(1).Resize(Target.Value).PasteSpecial
Application.CutCopyMode = False

End If
End Sub

 

[My Aswer Is This]

Change
If Target.column= 9
To
If Target.column=11