Forum Discussion
automate a workbook to move rows with a date older the 3 years
- May 16, 2023
May be, you can use the TODAY() function in Excel to get the current date and then subtract 3 years from it to get the date range you need.
Here’s an example of how you can do this using VBA:
Sub MoveRows() Dim mydate As Date mydate = DateAdd("yyyy", -3, Date) 'Get the date 3 years ago from today Dim lastrow As Long lastrow = Sheets("Sheet3").Cells(Rows.Count, "G").End(xlUp).Row 'Find the last row with data in column G of Sheet3 Dim i As Long For i = lastrow To 1 Step -1 'Loop through rows from bottom to top If Sheets("Sheet3").Cells(i, "G").Value < mydate Then 'If the date in column G is older than 3 years Sheets("Sheet3").Rows(i).Cut 'Cut the row Sheets("Sheet4").Rows(Sheets("Sheet4").Cells(Rows.Count, "G").End(xlUp).Row + 1).Insert Shift:=xlDown 'Insert the row into Sheet4 End If Next i End SubCode is untested.
Hope it helps you!
The error you are encountering is due to the fact that you're trying to rearrange cells within a table, which is not allowed using the Cut and Insert methods. To overcome this limitation, you can convert the table into a range, perform the rearrangement, and then convert it back into a table. Here is an updated version of the code that handles this scenario:
Sub MoveRows()
Dim mydate As Date
mydate = DateAdd("yyyy", -3, Date) 'Get the date 3 years ago from today
Dim lastrow As Long
Dim rngTable As Range
'Convert the table to a range
Set rngTable = Sheets("Sheet3").ListObjects("TableName").Range
rngTable.ListObject.Unlist
lastrow = rngTable.Cells(Rows.Count, "G").End(xlUp).Row 'Find the last row with data in column G of the range
Dim i As Long
For i = lastrow To 1 Step -1 'Loop through rows from bottom to top
If rngTable.Cells(i, "G").Value < mydate Then 'If the date in column G is older than 3 years
rngTable.Rows(i).Cut 'Cut the row
Sheets("Sheet4").Rows(Sheets("Sheet4").Cells(Rows.Count, "G").End(xlUp).Row + 1).Insert Shift:=xlDown 'Insert the row into Sheet4
End If
Next i
'Convert the range back into a table
Sheets("Sheet3").ListObjects.Add(xlSrcRange, rngTable, , xlYes).Name = "TableName"
End Sub
'untestedMake sure to replace "Sheet3" with the actual name of your source sheet and "Sheet4" with the actual name of your destination sheet. Also, replace "TableName" with the actual name of your table. This code should resolve the runtime error you were experiencing by properly handling the table conversion.
But as pointed out by the previous user peiyezhu , do you use Merge Cells ?
At the same time, information such as Excel version, operating system, storage medium, etc. would also be necessary in order to be able to submit a more precise solution proposal. Photos or a file (without sensitive data) would also help.
- sebring1983Jun 05, 2023Copper ContributorThe First code works, I forgot I had tables as I copy and pasted everything from another sheet I was working on that had tables.