Hello,

Have this problem whereby users are leaving filters applied in a workbook with multiple sheets.

This means that other users are opening the workbook and are unable to find data when they don't realise a filter has been applied.

Problem is, this workbook can be open by many users at one time, so a macro that clears and reapplies all filters when the workbook is opened would then clear filters for other users already in the workbook?

If this is not the case, is someone able to help me edit the below code to include "clear all filters on all sheets" then "reapply all filters on all sheets" when the workbook is opened?

Private Sub Workbook_Open()

    Application.ScreenUpdating = False
    
    'Set worksheet variables
    Dim WsC6 As Worksheet, WsP6 As Worksheet, WsP12 As Worksheet
    Set WsC6 = Worksheets("Current 6 months")
    Set WsP6 = Worksheets("Previous 6 months")
    Set WsP12 = Worksheets("Previous 12-24 Months")
    
    'Move old records from the Current 6 months sheet first
    Dim d As Date, d2 As Date, LRow As Long
    d = WorksheetFunction.EDate(Date, -6)
    d = Format(d, "dd/mm/yyyy")
    LRow = WsP6.Cells(Rows.Count, 1).End(3).Row + 1
    With WsC6.Range("A1").CurrentRegion
        .AutoFilter 10, "<" & CDbl(d)
        If WsC6.Cells(Rows.Count, 1).End(xlUp).Row > 1 Then
            .Offset(1).Resize(.Rows.Count - 1).Copy WsP6.Cells(LRow, 1)
            .Offset(1).Resize(.Rows.Count - 1).EntireRow.Delete
        End If
        WsC6.ShowAllData
    End With
    
    'Move old records from the Previous 6 months sheet second
    d2 = WorksheetFunction.EDate(Date, -12)
    d2 = Format(d2, "dd/mm/yyyy")
    LRow = WsP12.Cells(Rows.Count, 1).End(3).Row + 1
    With WsP6.Range("A1").CurrentRegion
        .AutoFilter 10, "<" & CDbl(d2)
        If WsP6.Cells(Rows.Count, 1).End(xlUp).Row > 1 Then
            .Offset(1).Resize(.Rows.Count - 1).Copy WsP12.Cells(LRow, 1)
            .Offset(1).Resize(.Rows.Count - 1).EntireRow.Delete
        End If
        .AutoFilter 10, ">" & CDbl(d), 2, "<" & CDbl(d2)
        If WsP6.Cells(Rows.Count, 1).End(xlUp).Row > 1 Then
            .Offset(1).Resize(.Rows.Count - 1).EntireRow.Delete
        End If
        WsP6.ShowAllData
    End With
    
    'Remove old records from the Previous 12-24 months sheet last
    d = WorksheetFunction.EDate(Date, -12)
    d = Format(d, "dd/mm/yyyy")
    d2 = WorksheetFunction.EDate(Date, -24)
    d2 = Format(d2, "dd/mm/yyyy")
    With WsP12.Range("A1").CurrentRegion
        .AutoFilter 10, ">" & CDbl(d), 2, "<" & CDbl(d2)
        If WsP12.Cells(Rows.Count, 1).End(xlUp).Row > 1 Then
            .Offset(1).Resize(.Rows.Count - 1).EntireRow.Delete
        End If
        WsP12.ShowAllData
    End With
    
    Application.ScreenUpdating = True
        Sheets("Current 6 months").Select
  Range("I1:I" & Range("I" & Rows.Count).End(3).Row + 1).Find("", Range("I1"), xlValues, xlWhole).Select
End Sub
Many Thanks