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

 

[Joe4]

You are welcome.