Add Specific number of rows based on cell value

[Utradeshow]

Hi All,

I have this code that adds rows based on the value of cell A2. I need two things. I would like the code to run after the value is entered in cell A2 vs having to press a add button. and also would like it to add rows starting from row 11 down? Is that possible?

Sub InsertRow()

  Dim ws As Worksheet
  Dim NBOFROWS As Range
  Set ws = ThisWorkbook.ActiveSheet

  With ws
    Set NBOFROWS = .Range("A2")
    ActiveCell.EntireRow.Offset(1).Resize(NBOFROWS.Value).Insert shift:=xlDown
  End With

End Sub

 

[Utradeshow]

TTI Agent Rate Calculator v1.01 - TEST.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z	AA	AB	AC	AD	AE	AF	AG
1
2
3	ADD ROWS		10												DOUBLE CLICK TO COPY DOWN
4	Location	Store Name	Region	Store Type	City	St	Zip	Address	Zip	Agent Name	City	State	Airport Code	Miles	UNITS	HOURS (4) MIN	HELPER REQUIRED	STORAGE REQUIRED	DISPOSAL REQUIRED	Handling IN	26' STRAIGHT / DRIVER	DRIVER (OT)	HELPER	HELPER (OT)	STORAGE	STORAGE OVERSIZE	Handling OUT	DISPOSAL	UDF	UDF	UDF	FUEL	TOTAL COST
5	C1	WEST HARTFORD			West Hartford	CT	06110	999 New Park Avenue	06095	TEST	Windsor	CT	BDL	9	1	4	NO	YES	NO	$25.00	$480.00	$0.00	$0.00	$0.00	$25.00	$0.00	$25.00	$0.00	$0.00	$0.00	$0.00	$75.00	$630.00
6	C2	NEWINGTON			Newington	CT	06111	1000 New Park Avenue	06095	TEST	Windsor	CT	BDL	13	1	4	NO	YES	NO	$25.00	$480.00	$0.00	$0.00	$0.00	$25.00	$0.00	$25.00	$0.00	$0.00	$0.00	$0.00	$75.00	$630.00
7	C3	MANCHESTER			Manchester	CT	06042	1001 New Park Avenue	06095	TEST	Windsor	CT	BDL	9	1	4	NO	YES	NO	$25.00	$480.00	$0.00	$0.00	$0.00	$25.00	$0.00	$25.00	$0.00	$0.00	$0.00	$0.00	$75.00	$630.00
8	C4	NORTH HAVEN			North Haven	CT	06473	1002 New Park Avenue	06801	TEST	Bethel	CT	BDL	28	1	4	NO	YES	NO	$25.00	$480.00	$0.00	$0.00	$0.00	$25.00	$0.00	$25.00	$0.00	$0.00	$0.00	$0.00	$75.00	$630.00
9	C5	ORANGE			Orange	CT	06477	1003 New Park Avenue	06801	TEST	Bethel	CT	BDL	20	1	4	NO	YES	NO	$25.00	$480.00	$0.00	$0.00	$0.00	$25.00	$0.00	$25.00	$0.00	$0.00	$0.00	$0.00	$75.00	$630.00
10	C6	WATERBURY			Waterbury	CT	06705	1004 New Park Avenue	06801	TEST	Bethel	CT	BDL	24	1	4	NO	YES	NO	$25.00	$480.00	$0.00	$0.00	$0.00	$25.00	$0.00	$25.00	$0.00	$0.00	$0.00	$0.00	$75.00	$630.00
11	C7	WATERFORD			Waterford	CT	06385	1005 New Park Avenue	06095	TEST	Windsor	CT	BDL	44	1	4	NO	YES	NO	$25.00	$480.00	$0.00	$0.00	$0.00	$25.00	$0.00	$25.00	$0.00	$0.00	$0.00	$0.00	$75.00	$630.00
12
13
14
15
16
17
18
19
20
21
22															7													GRAND TOTAL					$4,410.00
ROLLOUT

Cell Formulas
Range	Formula
K5:K11	K5	=VLOOKUP(I5,AGENTS!A:C,3,FALSE)
L5:L11	L5	=VLOOKUP(I5,AGENTS!A:D,4,FALSE)
M5:M11	M5	=VLOOKUP(I5,AGENTS!A:E,5,FALSE)
N5:N11	N5	=CDXDistance(G5,I5)
T5:T11	T5	=VLOOKUP(I5,AGENTS!A:G,7,FALSE)*O5
U5:U11	U5	=VLOOKUP(I5,AGENTS!A:K,11,FALSE)*P5
AA5:AA11	AA5	=VLOOKUP(I5,AGENTS!A:I,9,FALSE)*O5
AB5	AB5	=IF(S5="YES",VLOOKUP(I5,AGENTS!A:R,18,FALSE),0)*O5
AB6:AB11	AB6	=IF(Q6="YES",VLOOKUP(I6,AGENTS!A:R,18,FALSE),0)*O6
AF5:AF11	AF5	=VLOOKUP(I5,AGENTS!A:R,17,FALSE)
AG5:AG11	AG5	=SUM(T5:AF5)
I5:I11	I5	=CDXClosestZip(G5,0,AGENTS!$A$2:$A$165)*1
W5:W11	W5	=IF(Q5="YES",VLOOKUP(I5,AGENTS!A:M,13,FALSE),0)
Y5:Y11	Y5	=IF(R5="YES",(VLOOKUP(I5,AGENTS!A:O,15,FALSE)*O5),0)
O22,AG22	O22	=SUBTOTAL(9,O5:O21)

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("C3")) Is Nothing Or Range("C3") = "" Then Exit Sub
    Application.EnableEvents = False
    ActiveCell.EntireRow.Offset(8).Resize(Range("C3").Value).Insert Shift:=xlDown
    Application.EnableEvents = True
End Sub

Here is the actual sheet, I did change the ranges a little as the sheet changed.

 

[rollis13]

So in which row are the formulas to be copied? In post #8 you said they were in row 9. Now with the new layout it should be row 3 but I don't see any.

 

[Utradeshow]

So in which row are the formulas to be copied? In post #8 you said they were in row 9. Now with the new layout it should be row 3 but I don't

Yes, from row 3 down copying the formulas in row 2. I was trying to show the result of the current code.

 

[rollis13]

Tweak your macro to this:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("C3")) Is Nothing Or Range("C3") = "" Then Exit Sub
    Application.EnableEvents = False
    Range("A2").EntireRow.Copy
    Range("A5").EntireRow.Resize(Range("C3").Value).Insert Shift:=xlDown
    Application.CutCopyMode = False
    Application.EnableEvents = True
End Sub

Formulas in row 2 need to reference the same row (example for cell Y2):
=IF(R2="YES",(VLOOKUP(I2,Agents!A:O,15,FALSE)*O2),0)
so they can be correctly pasted in row 5 and on.

 

[Utradeshow]

Tweak your macro to this:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("C3")) Is Nothing Or Range("C3") = "" Then Exit Sub
    Application.EnableEvents = False
    Range("A2").EntireRow.Copy
    Range("A5").EntireRow.Resize(Range("C3").Value).Insert Shift:=xlDown
    Application.CutCopyMode = False
    Application.EnableEvents = True
End Sub

Formulas in row 2 need to reference the same row (example for cell Y2):
=IF(R2="YES",(VLOOKUP(I2,Agents!A:O,15,FALSE)*O2),0)
so they can be correctly pasted in row 5 and on.

Ok, Now were talkin! However, I do get #VALUE! as a result until I click into each cell and press enter again. It seems to be because the formula involves CDX ZipStream addin in Column I. If I replace with a value, it then copies all the normal formulas just fine.

Here is the formula in COLUMN I =@CDXClosestZip(G5,0,AGENTS!$A$2:$A$165)*1

 

[Utradeshow]

Actually, Cancel that last request! That was a user error. It works perfectly! Thank you so much for your time and extra effort.

 

[rollis13]

Yes, I was aware that would be possible issues with the Functions of columns I and N but since you didn't post them there was no way to check. Instead, have you checked the GRAND TOTAL in column AG and the one in column O ?
Anyway, thanks for the positive feedback, glad having been of some help.

 

[Utradeshow]

Yes, I was aware that would be possible issues with the Functions of columns I and N but since you didn't post them there was no way to check. Instead, have you checked the GRAND TOTAL in column AG and the one in column O ?
Anyway, thanks for the positive feedback, glad having been of some help.

The Grand total columns do not work, is there a fix for that?

 

[rollis13]

This could be a solution as long as there is no other data below the total in column AG:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim LastRow As Long                           '<- added
    If Intersect(Target, Range("C3")) Is Nothing Or Range("C3") = "" Then Exit Sub
    Application.EnableEvents = False
    Range("A2").EntireRow.Copy
    Range("A5").EntireRow.Resize(Range("C3").Value).Insert Shift:=xlDown
    LastRow = Range("AG" & Rows.Count).End(xlUp).Row '<- added
    Range("AG" & LastRow).Formula = "=SUM(AG5:AG" & LastRow - 1 & ")" '<- added
    Range("O" & LastRow).Formula = "=SUM(O5:O" & LastRow - 1 & ")" '<- added
    Application.CutCopyMode = False
    Application.EnableEvents = True
End Sub

 

[Utradeshow]

This could be a solution as long as there is no other data below the total in column AG:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim LastRow As Long                           '<- added
    If Intersect(Target, Range("C3")) Is Nothing Or Range("C3") = "" Then Exit Sub
    Application.EnableEvents = False
    Range("A2").EntireRow.Copy
    Range("A5").EntireRow.Resize(Range("C3").Value).Insert Shift:=xlDown
    LastRow = Range("AG" & Rows.Count).End(xlUp).Row '<- added
    Range("AG" & LastRow).Formula = "=SUM(AG5:AG" & LastRow - 1 & ")" '<- added
    Range("O" & LastRow).Formula = "=SUM(O5:O" & LastRow - 1 & ")" '<- added
    Application.CutCopyMode = False
    Application.EnableEvents = True
End Sub

Yes sir! That is beautiful, Thank you again!