Filter by Timer or countdown

brn2fly

New Member
Joined
Feb 27, 2019
Messages
1
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
 

Some videos you may like

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
6,410
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:

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

Watch MrExcel Video

Forum statistics

Threads
1,108,503
Messages
5,523,297
Members
409,509
Latest member
CheekyDevil2386

This Week's Hot Topics

Top