Moving Rows Between Sheets Automatically

[Dohtee]

First off all, I'm going to apologize. I know this question gets asked a ton, but I just can't seem to find a particular answer that is what I'm looking for.

So, I have two sheets with identical column headers. I would like both sheets to be formatted as basic tables.

The data being entered will be dates. I would like to have a macro so that when I enter a date into the last column available on sheet 1, the entire row will copy into the next available row on sheet 2, adhering to the table format, while being deleted from Sheet 1. I need sheet 2 to continuously update and not delete any data.

I would prefer triggering the macro by entering a date rather than entering a word like "Completed", but if this can't be done, I can use a trigger word. Does anybody have some decent VBA coding I could use to achieve this?

Thanks in advance!

 

[smozgur]

Hello, @Dohtee. Welcome to the MrExcel Message Board!

I created the following sample table in Sheet1 (In the future, that would be great if you could post the sample range by using XL2BB):

1174644.xlsm
	A	B	C
1	Field A	Field B	Field C
2	1	row1	1/2/2021
3	2	row2	1/3/2021
4	3	row3	1/5/2021
Sheet1

And I created the same table in Sheet2 but blank:

1174644.xlsm
	A	B	C
1	Field A	Field B	Field C
2
Sheet2

Finally, I created the following macro in the Sheet1 class module in VBAProject:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim table1 As ListObject
Dim table2 As ListObject
Dim fnd As Range
Dim table1Row As ListRow
Dim table2Row As ListRow
    Set table1 = Sheet1.ListObjects(1) ' Table in Sheet1
    If Target.Column = table1.Range.End(xlToRight).Column Then
        ' Search for the duplicate date entry in the last column of the table
        Set fnd = table1.DataBodyRange.Columns(table1.Range.Columns.Count).Find( _
            What:=Target.Value, _
            After:=Target, _
            LookIn:=xlValues, _
            LookAt:=xlWhole, _
            SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, _
            MatchCase:=False, _
            SearchFormat:=False)
        If Not fnd.Row = Target.Row Then
            Set table1Row = table1.ListRows(Target.Row - table1.Range.CurrentRegion.Row) ' Duplicate row in Sheet 1
            Set table2 = Sheet2.ListObjects(1) ' Table in Sheet2
            Set table2Row = table2.ListRows.Add ' Create new row in  Sheet2 table
            table2Row.Range.Cells.Value = table1Row.Range.Cells.Value ' Copy data from table1 to table2
            table1Row.Delete ' Remove the duplicate row in table1
        End If
    End If
End Sub

I wrote comments in the code, so it should explain what's going on. Please test it and see if it will work, and let me know if you have any questions.
Note: You need to update the sheet object names in the code. Note that I used the sheet class object names that you can see in the VBAProject window, not the sheet tab names. If you want to use tab names, then Sheet1 should be Thisworkbook.Worksheets("Sheet1") and similar for the other sheet. My sample shows the tables starting from cell A1 in both sheets but It should be matter where your tables are located as I used relative row and column indexes.

 

[smozgur]

Typo: “It should not matter where your tables are located as I used relative row and column indexes.”

 

[Dohtee]

Hello, @Dohtee. Welcome to the MrExcel Message Board!

I created the following sample table in Sheet1 (In the future, that would be great if you could post the sample range by using XL2BB):

1174644.xlsm
	A	B	C
1	Field A	Field B	Field C
2	1	row1	1/2/2021
3	2	row2	1/3/2021
4	3	row3	1/5/2021
Sheet1

And I created the same table in Sheet2 but blank:

1174644.xlsm
	A	B	C
1	Field A	Field B	Field C
2
Sheet2

Finally, I created the following macro in the Sheet1 class module in VBAProject:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim table1 As ListObject
Dim table2 As ListObject
Dim fnd As Range
Dim table1Row As ListRow
Dim table2Row As ListRow
    Set table1 = Sheet1.ListObjects(1) ' Table in Sheet1
    If Target.Column = table1.Range.End(xlToRight).Column Then
        ' Search for the duplicate date entry in the last column of the table
        Set fnd = table1.DataBodyRange.Columns(table1.Range.Columns.Count).Find( _
            What:=Target.Value, _
            After:=Target, _
            LookIn:=xlValues, _
            LookAt:=xlWhole, _
            SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, _
            MatchCase:=False, _
            SearchFormat:=False)
        If Not fnd.Row = Target.Row Then
            Set table1Row = table1.ListRows(Target.Row - table1.Range.CurrentRegion.Row) ' Duplicate row in Sheet 1
            Set table2 = Sheet2.ListObjects(1) ' Table in Sheet2
            Set table2Row = table2.ListRows.Add ' Create new row in  Sheet2 table
            table2Row.Range.Cells.Value = table1Row.Range.Cells.Value ' Copy data from table1 to table2
            table1Row.Delete ' Remove the duplicate row in table1
        End If
    End If
End Sub

I wrote comments in the code, so it should explain what's going on. Please test it and see if it will work, and let me know if you have any questions.
Note: You need to update the sheet object names in the code. Note that I used the sheet class object names that you can see in the VBAProject window, not the sheet tab names. If you want to use tab names, then Sheet1 should be Thisworkbook.Worksheets("Sheet1") and similar for the other sheet. My sample shows the tables starting from cell A1 in both sheets but It should be matter where your tables are located as I used relative row and column indexes.

My apologies. I definitely meant to post the range, however, my range is still not 100% set, so I don't mind having to make my own minor adjustments to the code to accommodate for range changes.

Also, I've implemented the code, but it doesn't seem to be doing anything. This is probably user error on my part as I'm just getting used to VBA, so I'll respecify what I'm working with and what I'm hoping to achieve, and if you can advise me on what I may need to do with this code, or if it needs adjusted, that would be awesome.

What I have currently is columns A-L filled with headers, with the headers representing different stages in daily projects. I will be filling the columns from left to right with dates and other data to track progress on active projects. What I would like to achieve, is that when I enter the date value (probably always being today's date) into column L, which represents the "project complete" date, the row will automatically be moved to the table in the "Closed" sheet for archival, and deleted from the "Active" sheet. If possible, I'd like this row to be added directly to the existing table without manual intervention. As I will be working with different project types, if the code can either be automatically or manually updated to work with different numbers of columns while still operating the same way, that would be great, and I in no way mind having to manually update parts of the coding.

I have a current VBA code that does this but requires a static trigger word to move the row, and also will not add to a table, but beneath it, requiring manual resizing of the table to include the new data. Not a huge deal, but I'd really like the current date to be the trigger so I don't waste a column for the trigger word. Manually resizing is also not a huge deal, but it would be a plus to remove that.

Thank you so much for your help.

 

[smozgur]

The data structure I prepared depends on your original post, and I am not even sure that it is what you have, or even we are on the same page at data structure.
It will surely require seeing your sample data structure.

 

[Dohtee]

The data structure I prepared depends on your original post, and I am not even sure that it is what you have, or even we are on the same page at data structure.
It will surely require seeing your sample data structure.

Alright. I'll try to use the tool you suggested to get a sample. I try to limit what's on my work laptop, but I'll recreate from my personal laptop tonight and update this post then.

Thanks!

 

[smozgur]

Alright. I'll try to use the tool you suggested to get a sample. I try to limit what's on my work laptop, but I'll recreate from my personal laptop tonight and update this post then.

Thanks!

That would be certainly helpful.

“XL2BB” is the official tool in the MrExcel Message Board 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.

As a reminder - please do not post any sensitive data as it will be all public when you do that.