Inserting new row based on cell value, and copying select data to the new row

[jibuchho]

I have a file for ongoing preventative maintenance. When a request is complete, they will fill in the completed date and the next date will calculate automatically. Then I want to create a new entry for the Next Date as a new row at the bottom of the table. I want to use a checkbox in the Create Next Entry column but for now will just use TRUE. That should be the trigger to create the entry. It won't simply be copying the existing row however as the "Next Scheduled Date" will need to be replace with "Next Date" and the completed date would again be empty. There are also a few other columns of hidden data for the sake of this example but those would need to copy as well - see below

Column Headings
Job | Next Scheduled Date | Equipment | Location | Schedule | Vendor/Employee | Progress | Completed Date | Next Date | Create Next Entry

 

[jibuchho]

Hi! Any chance someone has some insight on this?

 

[Joe4]

If you would be very helpful if you could post your example in a manner which allows us to copy/paste it, so we do not need to recreate it (cannot copy/paste images and get them to work like your sheet). MrExcel has a tool called “XL2BB” that lets you post samples of your data that will allow us to copy/paste it to our Excel spreadsheets, so we can work with the same copy of data that you are. Instructions on using this tool can be found here: XL2BB Add-in

Note that there is also a "Test Here” forum on this board. This is a place where you can test using this tool (or any other posting techniques that you want to test) before trying to use those tools in your actual posts.

Also, is all your data actually stored in a Data table in Excel, or is it just a list?
It gets a bit tricker if it is a table, because you actually then need to insert new rows into your table before you can add new data.

 

[Joe4]

Assuming it is a table, the following VBA code should do what you want, but it needs to be placed in the correct module.
To ensure that, follow the steps below:

1. Go to the sheet you want to apply this to
2. Right-click on the sheet tab name at the bottom of the screen
3. Select "View Code"
4. Paste the following VBA code in the VB Editor window that pops up

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim ws As Worksheet
    Dim tbl As ListObject
    Dim tblName As String
    Dim lr As Long

'   Exit if multiple cells updated at once
    If Target.CountLarge > 1 Then Exit Sub

'   See if value of TRUE added to column J after row 1
    If (Target.Column <> 10) Or (Target.Row = 1) Or (Target.Value <> True) Then Exit Sub

    Application.EnableEvents = False

'   Get last row in column A with data
    lr = Cells(Rows.Count, "A").End(xlUp).Row

'   Get table name of table starting in cell A1
    tblName = Range("A1").ListObject.Name

'   Add new row to bottom of table
    Set ws = ActiveSheet
    Set tbl = ws.ListObjects(tblName)
    tbl.ListRows.Add
    
'   Copy value from column A to new row
    Cells(lr + 1, "A").Value = Cells(Target.Row, "A").Value

'   Copy Next Date to Next Scheduled Date
    Cells(lr + 1, "B").Value = Cells(Target.Row, "I").Value
    
    Application.EnableEvents = True

End Sub

5. Save & close the VB Editor

Now, as you enter TRUE in column J, it will automatically create your new row and copy the data down.
If you have other columns you want to copy, just continue on with the two "Copy" sections of the code. The code should look the same, except for the column references.

 

[jibuchho]

Thank you - this is my first time posting. I appreciate your help. The table is named PM. I imported the code and added a couple more copy cells - see code changes below in blue. It's not quite working - no new row is created so nothing is copied. I am not getting an error or debugger. Any suggestions?

2024 Work Orders.xlsm
	A	B	C	D	E	F	G	H	I	J
4	Preventative Maintenance
5	Job	Next Scheduled Date	Equipment	Location	Schedule	Vendor/Employee	Progress	Completed Date	Next Date	Create Next Entry
6	5 YEAR CALIBRATION	3/1/2026	Heat/C02 Vent		5 years	??
7	ANNUAL FIRE PUMP CISTERN TREAT	6/1/2024	Fire Pump Cistern		Annually	???
8	SERVICE SOFTENERS 1 & 2	12/1/2024	Water Softeners		Bi-Monthly	Culligan
9	HVAC START UP	4/1/2024	HVAC System		Annually	Droegkamp
10	BOILER START UP	9/1/2024	Boiler 1 & 2		Annually	Droegkamp
11	HVAC SHUTDOWN	9/1/2024	HVAC System		Annually	Droegkamp
12	3 YEAR BOILER FLUSH & FILL	1/1/2026	Boiler 1 & 2		3 years	Droegkamp
13	5 YEAR TEST AND CALIBRATE	3/1/2027	Carbon Monoxide Sensor		5 years	Droegkamp
14	DRYER VENT CLEANING	3/1/2024	Dryer Vents		2 years	Dryer Vent Wizards
PM

Cell Formulas
Range	Formula
I6:I11,I13	I6	=IF([@[Completed Date]]="","",XLOOKUP([@Schedule],ScheduleDays[Schedule],ScheduleDays[Days])+[@[Completed Date]])

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
B6:B50	Dates Occurring	last month	text	NO
B6:B50	Dates Occurring	this month	text	NO

Cells with Data Validation
Cell	Allow	Criteria
E6:E51	List	=Lists!$AA$3:$AA$12
F6:F51	List	=Lists!$W$3:$W$14
G6:G51	List	=Lists!$U$3:$U$4
C6:C14	List	=Lists!$Y$3:$Y$27

Private Sub Worksheet_Change(ByVal Target As Range)

Dim ws As Worksheet
Dim tbl As ListObject
Dim tblName As String
Dim lr As Long

' Exit if multiple cells updated at once
If Target.CountLarge > 1 Then Exit Sub

' See if value of TRUE added to column J after row 1
If (Target.Column <> 10) Or (Target.Row = 1) Or (Target.Value <> True) Then Exit Sub

Application.EnableEvents = False

' Get last row in column A with data
lr = Cells(Rows.Count, "A").End(xlUp).Row

' Get table name of table starting in cell A5
tblName = Range("A5").ListObject.Name

' Add new row to bottom of table
Set ws = ActiveSheet
Set tbl = ws.ListObjects(tblName)
tbl.ListRows.Add

' Copy value from column A to new row
Cells(lr + 1, "A").Value = Cells(Target.Row, "A").Value

' Copy value from column C to new row
Cells(lr + 1, "C").Value = Cells(Target.Row, "C").Value

' Copy Next Date to Next Scheduled Date
Cells(lr + 1, "B").Value = Cells(Target.Row, "I").Value

Application.EnableEvents = True

End Sub

 

[Joe4]

OK, let's add in a few message boxes for debugging purposes:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim ws As Worksheet
Dim tbl As ListObject
Dim tblName As String
Dim lr As Long

MsgBox "Code is running!"

' Exit if multiple cells updated at once
If Target.CountLarge > 1 Then Exit Sub

' See if value of TRUE added to column J after row 1
If (Target.Column <> 10) Or (Target.Row = 1) Or (Target.Value <> True) Then Exit Sub

Application.EnableEvents = False

' Get last row in column A with data
lr = Cells(Rows.Count, "A").End(xlUp).Row
MsgBox "Last row is " & lr, vbOKOnly

' Get table name of table starting in cell A5
tblName = Range("A5").ListObject.Name

' Add new row to bottom of table
Set ws = ActiveSheet
Set tbl = ws.ListObjects(tblName)
tbl.ListRows.Add

' Copy value from column A to new row
Cells(lr + 1, "A").Value = Cells(Target.Row, "A").Value

' Copy value from column C to new row
Cells(lr + 1, "C").Value = Cells(Target.Row, "C").Value

' Copy Next Date to Next Scheduled Date
Cells(lr + 1, "B").Value = Cells(Target.Row, "I").Value

Application.EnableEvents = True

End Sub

Whenever you update a value, you should see a message saying "Code is running".
And then when you update a TRUE in column J, you should also see another message box telling you the number of the last row.
Does that last row number look correct? It could be problematic if you have something below your table or blank rows at the bottom of your table.

 

[jibuchho]

That is fantastic - problem solved. Thank you!!!

 

[Joe4]

That is fantastic - problem solved. Thank you!!!

So what was the issue?
All I did was add a few Message Boxes to aid in debugging. I didn't change any code that would change how it is running.