Forum Discussion

sebring1983's avatar
sebring1983
Copper Contributor
May 15, 2023
Solved

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

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.

excel
Macros and VBA
  • NikolinoDE's avatar
    NikolinoDE
    May 16, 2023

    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!

5 Replies

Sort By
  • NikolinoDE's avatar
    NikolinoDE
    Gold Contributor
    May 16, 2023

    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!

    • sebring1983's avatar
      sebring1983
      Copper Contributor
      Jun 03, 2023
      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.
      • NikolinoDE's avatar
        NikolinoDE
        Gold Contributor
        Jun 04, 2023

        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.

Resources