Filter by Timer or countdown

[brn2fly]

How can you make a filter automatically toggle every few minutes. I have a sheet with sales information for all salespeople. I would like it to filter by salesperson and change to the next salesperson every minute or two. Thanks

 

[John_w]

Try this code. Without knowing the exact layout of your data, I've made some assumptions: the sales data is on Sheet1 columns A to D, with column headings in row 1 and column B containing the salespersons. For test purposes, the AutoFilter interval is set to 5 seconds.

Put this code in the ThisWorkbook module:

Option Explicit

Private Sub Workbook_Open()
    StartTimer
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    StopTimer
End Sub

Put this code in a standard module:

Option Explicit

Public RunWhen As Double
Public Const cRunWhat = "AutoFilter_Next_Salesperson"
Public Const cAutoFilterIntervalSeconds = 5

Dim SalespersonDict As Object
Dim SalespersonDictIndex As Long


Public Sub StartTimer()
    RunWhen = DateAdd("s", cAutoFilterIntervalSeconds, Now)
    Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, Schedule:=True
End Sub


Public Sub StopTimer()
    On Error Resume Next
    Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, Schedule:=False
End Sub


Public Sub AutoFilter_Next_Salesperson()

    Static SalesData As Range
    Dim SalespersonColumnValues As Variant
    Dim i As Long
    
    If SalespersonDict Is Nothing Then
        
        With ThisWorkbook.Worksheets("Sheet1")
        
            'Create range for sales data: A1 to last row in column D. Row 1 contains column headings.
        
            Set SalesData = .Range("A1", .Cells(.Rows.Count, "D").End(xlUp))
        
            'Create Dictionary containing unique values in column B - the Salesperson column
            
            SalespersonColumnValues = .Range("B2", .Cells(.Rows.Count, "B").End(xlUp))
            Set SalespersonDict = CreateObject("Scripting.Dictionary")
            For i = 1 To UBound(SalespersonColumnValues, 1)
                SalespersonDict(SalespersonColumnValues(i, 1)) = 1
            Next
            SalespersonDictIndex = 0
                
        End With
                
    End If
        
    'AutoFilter on Salesperson column (column B, i.e. Field 2) with the current SalespersonDictIndex key
        
    SalesData.AutoFilter Field:=2, Criteria1:=SalespersonDict.Keys()(SalespersonDictIndex)

    'Increment the key index
    
    SalespersonDictIndex = SalespersonDictIndex + 1
    If SalespersonDictIndex = SalespersonDict.Count Then SalespersonDictIndex = 0
            
    'Restart timer
    
    StartTimer
    
End Sub

Save the workbook (as a .xlsm or .xlsb file), close and reopen to test the code.