VBA Insert Row & copy formulas

[keef2]

Hi all,

I am in need of some fine tuning. I created this VBA code that works but it doesnt copy the formulas to the inserted row. Lastly, i currently have it as user input for the qty of rows to add.

Looking for help to just adjust this to insert 1 row and remove the dialog box also to copy the formulas into the inserted row. Thanks in advance!

Sub AddInputRow()
    subName = "AddInputRow" 'For Error handling only

    On Error GoTo Nope

    'Get active sheet
    Dim act As Worksheet
    Set act = ThisWorkbook.ActiveSheet

    'prompt for suer entry and loop back if invalid
    StrPrompt = "Enter number of rows to insert:"

Redo:
    xNum = Application.InputBox(StrPrompt, "Insert Rows at Bottom", , , , , , Type:=1)
    If xNum = 0 Or xNum = "" Or xNum = vbNullString Then
        'User Cancelled and close box
    ElseIf xNum < 1 Or Int(xNum) / xNum <> 1 Then
        'User entered a non-positive integer
        GoTo Redo
    Else
'Add rows and update formattingand formulas
    bot_row = act.Range("Z1")
    act.Rows(bot_row & ":" & bot_row + (xNum - 1)).Insert Shift:=x1ShiftDown
    act.Range("A" & bot_row - 1 & ":P" & bot_row - 1).Copy
    act.Range("A" & bot_row & ":P" & bot_row + (xNum - 1)).PasteSpecial xlPasteFormats
    act.Range("A" & bot_row - 1 & ":B" & bot_row - 1 & ":C" & bot_row - 1 & ":D" & bot_row - 1 & ":E" & bot_row - 1 & ":F" & bot_row - 1 & ":G" & bot_row - 1 & ":H" & bot_row - 1 & ":I" & bot_row - 1 & ":J" & bot_row - 1 & ":K" & bot_row - 1 & ":L" & bot_row - 1 & ":M" & bot_row - 1 & ":N" & bot_row - 1 & ":O" & bot_row - 1 & ":P" & bot_row - 1).Copy
    act.Range("A" & bot_row - 1 & ":B" & bot_row - 1 & ":C" & bot_row - 1 & ":D" & bot_row - 1 & ":E" & bot_row - 1 & ":F" & bot_row - 1 & ":G" & bot_row - 1 & ":H" & bot_row - 1 & ":I" & bot_row - 1 & ":J" & bot_row - 1 & ":K" & bot_row - 1 & ":L" & bot_row - 1 & ":M" & bot_row - 1 & ":N" & bot_row - 1 & ":O" & bot_row - 1 & ":P" & bot_row - 1).PasteSpecial xlPasteFormulas
    Application.CutCopyMode = False
    act.Range("A" & bot_row).Activate
    ActiveWindow.ScrollRow = bot_row - 10
End If

Continue:
    'Calculate everything once when finished and enable events
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Exit Sub
    
'Do this if error occurs
Nope:
    MsgBox "An error has been logged: " & vbNewLine & ThisWorkbook.ActiveSheet.Name & vbNewLine & subName & "(Line " & Erl & ")" & vbNewLine & Err.Description
    Resume Continue
    
End Sub

 

[keef2]

Sorry here is the sheet:

masterjoblist - V0.1.xlsm
	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P
1	Monthly Sales
3		January	Febuary	March	April	May	June	July	August	September	October	November	December	TOTAL SALES
4	2012	$ 217,787	$ 714,700	$ 80,019	$ 7,908,552	$ 3,674,515	$ 522,802	$ 2,398,672	$ 1,251,678	$ 28,843	$ 17,573	$ 9,400	$ 847,565	$ 17,672,106	2012
5	2013	$ 3,093,415	$ 1,090,780	$ 1,623,840	$ 1,796,440	$ 1,717,774	$ 1,044,612	$ 1,825,158	$ 3,733,815	$ 637,388	$ 869,792	$ 2,370,985	$ 823,075	$ 20,627,074	2013
6	2014	$ 2,078,895	$ 2,626,000	$ 6,653,426	$ 36,380	$ 2,859,745	$ 831,390	$ 1,937,547	$ 3,483,615	$ 2,140,838	$ 647,872	$ 1,137,422	$ 67,600	$ 24,500,730	2014
7	2015	$ 2,533,585	$ 2,091,747	$ 4,494,199	$ 1,702,275	$ 1,005,674	$ 2,167,017	$ 7,680,620	$ 110,592	$ 3,045,928	$ 10,878,519	$ 95,300	$ 3,564,216	$ 39,369,672	2015
8	2016	$ 409,465	$ 1,832,825	$ 3,244,407	$ 3,904,514	$ 2,306,938	$ 5,429,274	$ 843,556	$ 8,298,244	$ 4,035,878	$ 1,192,207	$ 7,591,000	$ 92,750	$ 39,181,058	2016
9	2017	$ 3,465,280	$ 1,513,817	$ 6,584,535	$ 879,800	$ 1,218,100	$ 2,192,697	$ 298,450	$ 3,302,787	$ 2,806,055	$ 3,908,009	$ 458,937	$ 1,412,888	$ 28,043,372	2017
10	2018	$ 4,351,558	$ 270,195	$ 2,116,150	$ 5,489,089	$ 2,985,495	$ 2,456,650	$ 8,331,072	$ 2,442,865	$ 3,261,885	$ 367,150	$ 304,861	$ 3,049,779	$ 35,428,767	2018
11	2019	$ 113,838	$ 7,071,370	$ 1,380,520	$ 747,983	$ 5,226,733	$ 1,606,520	$ 7,148,845	$ 1,351,090	$ 792,577	$ 7,278,820	$ 4,818,686	$ 2,516,597	$ 40,055,598	2019
12	2020	$ 1,057,457	$ 5,948,478	$ 2,712,030	$ 1,014,750	$ 1,511,408	$ 1,182,030	$ 4,516,640	$ 3,857,360	$ 2,769,944	$ 1,685,050	$ 1,704,698	$ 2,772,694	$ 30,734,559	2020
13	2021	$ 4,090,350	$ 2,652,478	$ 9,143,516	$ 9,014,203	$ 6,060,405	$ 2,350	$ 8,571,295	$ 11,607,380	$ 535,470	$ 13,199,409	$ 4,606,389	$ 383,525	$ 69,866,770	2021
14	2022	$ 8,128,763	$ 5,401,750	$ 3,765,450	$ 12,984,905	$ 7,812,055	$ 319,975	$ 500,800	$ 97,500	$ -	$ -	$ -	$ -	$ 39,011,198	2022
15
16	2023	$ -	$ -	$ -	$ -	$ -	$ -	$ -	$ -	$ -	$ -	$ -	$ -	$ -	2023
sales by month

Cell Formulas
Range	Formula
C16:N16,C4:N14	C4	=SUM(IF(ISNUMBER(MASTER!$E:$E),IF((MONTH(MASTER!$E:$E)='sales by month'!C$2)*(YEAR(MASTER!$E:$E)='sales by month'!$B4),MASTER!$G:$G)))
O16,O4:O8,O13:O14	O4	=SUM(C4:N4)
P16,P4:P14	P4	=B4
B5:B14	B5	=B4+1
O9:O12	O9	=SUM(B9:N9)
B16	B16	=B14+1

 

[keef2]

I got the formulas to copy over it was a typo on my end. Here is the new code. Although simple, any guidance on how to Modify the code to not have a dialog box and just insert 1 row above the bottom with my reference to the bottom row? Here is the updated code that is working.

Sub AddInputRow()
    subName = "AddInputRow" 'For Error handling only

    On Error GoTo Nope

    'Get active sheet
    Dim act As Worksheet
    Set act = ThisWorkbook.ActiveSheet

    'prompt for user entry and loop back if invalid
    StrPrompt = "Enter number of rows to insert:"

Redo:
    xNum = Application.InputBox(StrPrompt, "Insert Rows at Bottom", , , , , , Type:=1)
    If xNum = 0 Or xNum = "" Or xNum = vbNullString Then
        'User Cancelled and close box
    ElseIf xNum < 1 Or Int(xNum) / xNum <> 1 Then
        'User entered a non-positive integer
        GoTo Redo
    Else
'Add rows and update formatting and formulas
    bot_row = act.Range("Z1")
    act.Rows(bot_row & ":" & bot_row + (xNum - 1)).Insert Shift:=x1ShiftDown
    act.Range("A" & bot_row - 1 & ":P" & bot_row - 1).Copy
    act.Range("A" & bot_row & ":P" & bot_row + (xNum - 1)).PasteSpecial xlPasteFormats
    act.Range("A" & bot_row - 1 & ":B" & bot_row - 1 & ":C" & bot_row - 1 & ":D" & bot_row - 1 & ":E" & bot_row - 1 & ":F" & bot_row - 1 & ":G" & bot_row - 1 & ":H" & bot_row - 1 & ":I" & bot_row - 1 & ":J" & bot_row - 1 & ":K" & bot_row - 1 & ":L" & bot_row - 1 & ":M" & bot_row - 1 & ":N" & bot_row - 1 & ":O" & bot_row - 1 & ":P" & bot_row - 1).Copy
    act.Range("A" & bot_row & ":B" & bot_row & ":C" & bot_row & ":D" & bot_row & ":E" & bot_row & ":F" & bot_row & ":G" & bot_row & ":H" & bot_row & ":I" & bot_row & ":J" & bot_row & ":K" & bot_row & ":L" & bot_row & ":M" & bot_row & ":N" & bot_row & ":O" & bot_row & ":P" & bot_row + (xNum - 1)).PasteSpecial xlPasteFormulas
    Application.CutCopyMode = False
    act.Range("A" & bot_row).Activate
    ActiveWindow.ScrollRow = bot_row - 10
End If

Continue:
    'Calculate everything once when finished and enable events
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Exit Sub
    
'Do this if error occurs
Nope:
    MsgBox "An error has been logged: " & vbNewLine & ThisWorkbook.ActiveSheet.Name & vbNewLine & subName & "(Line " & Erl & ")" & vbNewLine & Err.Description
    Resume Continue
    
End Sub