VBA move rows once date in past

Tshurlock

New Member
Joined
Jun 28, 2018
Messages
6
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
 

Some videos you may like

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce

My Aswer Is This

Well-known Member
Joined
Jul 5, 2014
Messages
16,762
Office Version
2013
Platform
Windows
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

New Member
Joined
Jun 28, 2018
Messages
6
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

Well-known Member
Joined
Jul 5, 2014
Messages
16,762
Office Version
2013
Platform
Windows
Try this:
Will copy all rows where column B date is less then Today

Code:
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

New Member
Joined
Jun 28, 2018
Messages
6
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

Well-known Member
Joined
Jul 5, 2014
Messages
16,762
Office Version
2013
Platform
Windows
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
 

Watch MrExcel Video

Forum statistics

Threads
1,102,448
Messages
5,486,958
Members
407,574
Latest member
Greso

This Week's Hot Topics

Top