VBA move rows once date in past

[Tshurlock]

Hi I have seen lots of discussion on VBA moving rows to another worksheet based on a value eg "done" which have worked for me. However what I am currently trying to do is move rows based on date, each row has a due date and once this date has passed I would like to move the row to a different worksheet. Any help would be much appreciated. Kind regards Tim

 

[My Aswer Is This]

We always need specific details:
1. What column is the date in? Say column B or G something like that. Do not say column Date
2. You said move the row. Does that mean copy row to other sheet and delete from orginal sheet?
3. What is the name of the copy from sheet and the Copy to sheet.
4.And the script will be activated by pressing a button correct?
If not how should the script be activated.

 

[Tshurlock]

We always need specific details:
1. What column is the date in? Say column B or G something like that. Do not say column Date
2. You said move the row. Does that mean copy row to other sheet and delete from orginal sheet?
3. What is the name of the copy from sheet and the Copy to sheet.
4.And the script will be activated by pressing a button correct?
If not how should the script be activated.

Hi, thanks for your response, the additional detail;
1. Column B
2. Yes
3. Copy from "current engagement" copy to "archive engagement"
4. Yes, activated by pressing a button, I anticipate that everytime I run the script it will move the rows that are now in the past

Many thanks Tim

 

[My Aswer Is This]

Try this:
Will copy all rows where column B date is less then Today

Sub Filter_Me_Please()
'Modified  7/30/2019  1:34:32 PM  EDT
Application.ScreenUpdating = False
Sheets("current engagement").Activate
Dim Lastrow As Long
Dim Lastrowa As Long
Lastrowa = Sheets("archive engagement").Cells(Rows.Count, "B").End(xlUp).Row + 1
Dim c As Long
Dim s As Variant
c = 2 ' Column Number Modify this to your need
s = "<" & Date 'Search Value Modify to your need
Lastrow = Cells(Rows.Count, c).End(xlUp).Row
With ActiveSheet.Cells(1, c).Resize(Lastrow)
    .AutoFilter 1, s
    counter = .Columns(c).SpecialCells(xlCellTypeVisible).Count
    If counter > 1 Then
        .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets("archive engagement").Rows(Lastrowa)
        .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    
    Else
        MsgBox "No values found"
    End If
    .AutoFilter
End With
Application.ScreenUpdating = True
End Sub

 

[Tshurlock]

Hi, thanks for this and apologies for my ignorance, when I try to run this I get runtime error 1004, autofilter method of range class failed and it highlights ".autofilter 1, s

 

[My Aswer Is This]

You need to check these sheet names. Look in the script and you will see:

current engagement

and:

archive engagement

are these your two sheet names?

If not change the script. These are the names you mentioned in Post 1
​