Sub WorkBook_Open()
Application.ScreenUpdating = False
Sheets("sheet1").Select
Columns("A:D").Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Dim lngS1LastRow As Long
Dim lngS2LastRow As Long
Dim FilteredRange As Range
Dim rng As Range
Range("A2").Select
lngS1LastRow = Worksheets("Log").Range("A" & Rows.Count).End(xlUp).Row
lngS2LastRow = Worksheets("Archives").Range("A" & Rows.Count).End(xlUp).Row
Sheets("Log").Select
With Worksheets("Log")
.AutoFilterMode = False
With Range("A1:F" & lngS1LastRow)
.AutoFilter
.AutoFilter Field:=6, Criteria1:="Yes"
End With
End With
With Worksheets("Log").AutoFilter.Range
On Error Resume Next
Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
End With
If rng Is Nothing Then
With Worksheets("Log")
.AutoFilterMode = False
'Application.ScreenUpdating = True
MsgBox "All disciplinary actions older than 1 year have been removed!"
Sheets("Home").Select
Exit Sub
End With
Else
Set rng = ActiveSheet.AutoFilter.Range
rng.Offset(1, 0).Resize(rng.Rows.Count - 1).Copy _
Destination:=Worksheets("Archives").Range("A" & lngS2LastRow + 1)
rng.Offset(1, 0).Resize(rng.Rows.Count - 1).Delete Shift:=xlUp
MsgBox "All disciplinary actions older than 1 year have been removed!"
End If
'Msg = "Are you ready to update all installed accounts?"
'ans = MsgBox(Msg, vbOKCancel)
'If ans = vbCancel Then Exit Sub
Worksheets("Log").AutoFilterMode = False
Worksheets("Home").Select
Application.ScreenUpdating = True
End Sub