VBA to copy range to bottom of existing table

[keef2]

Hello,

I am hoping someone can help me with VBA code. Looking to copy the format and formulas from range A3:J8 and paste below the bottom of the list which in this case would be starting Row 45. I also am hoping to have a dialog box that the user inputs how many projects to add. For example this would allow user to input 1 or input x num and add the range or x num ranges to bottom of table. Any help would be much appreciated. My current VBA code is not doing what I was hoping. Any help is much appreciated. Thanks in advance!

Here is the workbook:

Thursday KEM WORKING.xlsx
	A	B	C	D	E	F	G	H	I	J
1
2	Day of Week:		Friday		Job/Location			Date:	9/2/2022
3	Job #:	3389	Job Name:		Kanebridge Expansion				Time:	7:00
4			Location:		1125 Gateway Drive, Elgin, IL 60123
5	Employees :
6
7
8
9	Job #:	3388	Job Name:		Schaumburg Honda				Time:	7:00
10			Location:		1100 E. Golf Rd. Schaumburg, IL 60173
11	Employees :
12
13
14
15	Job #:		Job Name:						Time:	7:00
16			Location:
17	Employees :
18
19
20
21	Job #:		Job Name:						Time:	7:00
22			Location:
23	Employees :
24
25
26
27	Job #:		Job Name:						Time:	7:00
28			Location:
29	Employees :
30
31
32
33	Job #:		Job Name:						Time:	7:00
34			Location:
35	Employees :
36
37
38
39	Job #:		Job Name:						Time:	7:00
40			Location:
41	Employees :
42
43
44
Schedule

Cell Formulas
Range	Formula
C2	C2	=TEXT(I2,"dddd")
I2	I2	=TODAY()
E3,E39,E33,E27,E21,E15,E9	E3	=IFERROR(VLOOKUP(B3,Table2,2,FALSE),"")
E4,E40,E34,E28,E22,E16,E10	E4	=IFERROR(VLOOKUP(B3,Table2,3,FALSE),"")

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
E39	Expression	=COUNTIF($C39,"*Job*")	text	NO
E33	Expression	=COUNTIF($C33,"*Job*")	text	NO
E27	Expression	=COUNTIF($C27,"*Job*")	text	NO
E21	Expression	=COUNTIF($C21,"*Job*")	text	NO
E15	Expression	=COUNTIF($C15,"*Job*")	text	NO
C39:D39,F39:H39	Expression	=COUNTIF($C39,"*Job*")	text	NO
C33:D33,F33:H33	Expression	=COUNTIF($C33,"*Job*")	text	NO
C27:D27,F27:H27	Expression	=COUNTIF($C27,"*Job*")	text	NO
C21:D21,F21:H21	Expression	=COUNTIF($C21,"*Job*")	text	NO
C15:D15,F15:H15	Expression	=COUNTIF($C15,"*Job*")	text	NO
C3:H3,C9:H9	Expression	=COUNTIF($C3,"*Job*")	text	NO

Here is my current VBA code:

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 Jobs 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 Main Table & Sales Table and update formatting and formulas
    bot_row = act.Range("AZ1")
    act.Rows(bot_row & ":" & bot_row + (xNum - 1)).Insert Shift:=x1ShiftDown
    act.Range("A3" & bot_row - 1 & ":J8" & bot_row - 1).Copy act.Range("A3" & bot_row & ":J8" & bot_row + (xNum - 1))
    Application.CutCopyMode = False
 
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

 

[MEUserII]

How is the starting row determined for your application (where in the case described above it was row 45)?

Once how the starting row is determined the VBA code desired essentially is just a copy-range loop that is dynamically iterated/incremented based on an input box entry for the user to input: 1 to x; as mentioned for the 'num ranges' described.

 

[keef2]

How is the starting row determined for your application (where in the case described above it was row 45)?

Once how the starting row is determined the VBA code desired essentially is just a copy-range loop that is dynamically iterated/incremented based on an input box entry for the user to input: 1 to x; as mentioned for the 'num ranges' described.

i use the Row () function in cell "AZ1". Again the VBA code i have currently doesnt copy the whole range it is only adding 1 row that is blank. If there is a better way to write this code I am all ears.

Thanks!

 

[keef2]

Ok lets forget the input box. Simply want a button that when clicked copies range A3:J8 and past below the bottom of the data to keep all formats and formulas. Any help? I always do it with 1 row but havent been able to get it with a range... Thanks again.

 

[keef2]

Update: I have the following VBA code that does what I want it to do now. However, how can I code it to clear column B for the added group in this scenario its B27. Also see the red text in the XL2BB snip. If there is a better way to write this code please let me know! Thanks again!

Sub Add_Job()
    
    Dim act As Worksheet
    Set act = ThisWorkbook.ActiveSheet
    bot_row = act.Range("Z1")
    
    act.Rows(bot_row & ":" & bot_row + (5)).Insert Shift:=x1ShiftDown
    act.Range("A3:J8").Copy
    act.Range("A" & bot_row & ":J" & bot_row + (5)).PasteSpecial xlPasteFormats
    act.Range("A" & bot_row & ":J" & bot_row + (5)).PasteSpecial xlPasteFormulas
    
    Application.CutCopyMode = False
    
End Sub

Thursday KEM WORKING.xlsm
	A	B	C	D	E	F	G	H	I	J
1
2	Day of Week:		Friday		Job/Location			Date:	9/2/2022
3	Job #:	3389	Job Name:		Kanebridge Expansion				Time:	7:00
4			Location:		1125 Gateway Drive, Elgin, IL 60123
5	Employees :
6
7
8
9	Job #:	3389	Job Name:		Kanebridge Expansion				Time:	7:00
10			Location:		1125 Gateway Drive, Elgin, IL 60123
11	Employees :
12
13
14
15	Job #:	3388	Job Name:		Schaumburg Honda				Time:	7:00
16			Location:		1100 E. Golf Rd. Schaumburg, IL 60173
17	Employees :
18
19
20
21	Job #:		Job Name:						Time:	7:00
22			Location:
23	Employees :
24
25
26
27	Job #:	3389	Job Name:		Kanebridge Expansion				Time:	7:00
28			Location:		1125 Gateway Drive, Elgin, IL 60123
29	Employees :
30				This was the added section after I hit add job.
31				Looking to clear cell at least B27 and so forth anytime the button is hit
32
Schedule

Cell Formulas
Range	Formula
C2	C2	=TEXT(I2,"dddd")
I2	I2	=TODAY()
E3,E27,E21,E15,E9	E3	=IFERROR(VLOOKUP(B3,Table2,2,FALSE),"")
E4,E28,E22,E16,E10	E4	=IFERROR(VLOOKUP(B3,Table2,3,FALSE),"")

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
C27:H27	Expression	=COUNTIF($C27,"*Job*")	text	NO
E21	Expression	=COUNTIF($C21,"*Job*")	text	NO
E15	Expression	=COUNTIF($C15,"*Job*")	text	NO
C21:D21,F21:H21	Expression	=COUNTIF($C21,"*Job*")	text	NO
C15:D15,F15:H15	Expression	=COUNTIF($C15,"*Job*")	text	NO
C3:H3,C9:H9	Expression	=COUNTIF($C3,"*Job*")	text	NO

 

[Joe4]

However, how can I code it to clear column B for the added group in this scenario its B27.

Try adding this line after your paste lines:

act.Range("B" & bot_row).ClearContents

 

[keef2]

Try adding this line after your paste lines:

act.Range("B" & bot_row).ClearContents

That didnt work. It still inserts the copied range and paste but doesnt clear the contents and provides this error:

 

[Joe4]

Actually, I do not think you need the sheet reference at all, since this is all happening on the active sheet (though that should not cause an error).

If you want all those newly added rows to be blank, you could just use:

Range("B" & bot_row & ":B" & bot_row + (5)).ClearContents

But what exactly is your value of "bot_row" when you get this error?
If looks like it is coming from cell Z1 (not sure why it is stored here or how it is being calculated):

    bot_row = act.Range("Z1")

 

[keef2]

Actually, I do not think you need the sheet reference at all, since this is all happening on the active sheet (though that should not cause an error).

If you want all those newly added rows to be blank, you could just use:

Range("B" & bot_row & ":B" & bot_row + (5)).ClearContents

But what exactly is your value of "bot_row" when you get this error?
If looks like it is coming from cell Z1 (not sure why it is stored here or how it is being calculated):

    bot_row = act.Range("Z1")

The problem is i dont want to clear all contents from the copied range as there are 2 formulas there. Z1=Row() which i use to establish bottom of table if you will. Currently its Row 27 but when you hit the button it changes to 33 then to 39 and so on. Based on how many times the button is clicked.

 

[keef2]

Actually, I do not think you need the sheet reference at all, since this is all happening on the active sheet (though that should not cause an error).

If you want all those newly added rows to be blank, you could just use:

Range("B" & bot_row & ":B" & bot_row + (5)).ClearContents

But what exactly is your value of "bot_row" when you get this error?
If looks like it is coming from cell Z1 (not sure why it is stored here or how it is being calculated):

    bot_row = act.Range("Z1")

that updated code worked like a charm. Thanks!