mykal66
01-07-2020, 08:16 AM
I’m setting up a planner at work and want any meetings thatare in the past to be moved to another worksheet when the file is opened.
I’ve found some code elsewhere (below) which I have tried toadapt but can’t get it to work. Cananyone see what I haven’t changed correctly please?
The main TAB is Forward Look Planner and the dates in in ColumnC (Starting C4). The second other TAB iscalled Archived.
This is the code I have tried to change but it doesn’t work!
As always, thank you for any help.
Mykal
Private Sub Workbook_Open()
Application.ScreenUpdating = False
Sheets("Forward Look Planner").Activate
Dim Lastrow As Long
Dim Lastrowa As Long
Lastrowa = Sheets("Archived").Cells(Rows.Count, "A").End(xlUp).Row + 1
Dim c As Long
Dim s As Variant
c = 3 ' 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("Archived").Rows(Lastrowa)
.Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End If
.AutoFilter
End With
Application.ScreenUpdating = True
End Sub
I’ve found some code elsewhere (below) which I have tried toadapt but can’t get it to work. Cananyone see what I haven’t changed correctly please?
The main TAB is Forward Look Planner and the dates in in ColumnC (Starting C4). The second other TAB iscalled Archived.
This is the code I have tried to change but it doesn’t work!
As always, thank you for any help.
Mykal
Private Sub Workbook_Open()
Application.ScreenUpdating = False
Sheets("Forward Look Planner").Activate
Dim Lastrow As Long
Dim Lastrowa As Long
Lastrowa = Sheets("Archived").Cells(Rows.Count, "A").End(xlUp).Row + 1
Dim c As Long
Dim s As Variant
c = 3 ' 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("Archived").Rows(Lastrowa)
.Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End If
.AutoFilter
End With
Application.ScreenUpdating = True
End Sub