automate a workbook to move rows with a date older the 3 years

[sebring1983]

I am trying to automate a workbook to move rows with a date older the 3 years from sheet3 ( dates are in column G ) to sheet4. I can get it to work with If mydate only if I specify the date range of say 12-mar-2022 and 20-mar-2023 but I would like to have it use today's date so that I do not have to edit this every time.

[#2 · Accepted solution]

@sebring1983 

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 Sub

Code is untested.

Hope it helps you!

[#3]

Looks like this is exactly what I am looking for but I am running into Run-time error'1004" You can't rearrange cells within a table this way, because it might affect other table cells in an unexpected way.

[#4]

can't rearrange cells within a table this way,

Do you use merge cells?

[#5]

@sebring1983 

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
'untested

Make 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.

[#6]

The First code works, I forgot I had tables as I copy and pasted everything from another sheet I was working on that had tables.