Automate Excel Table Filters Using VBA and Activate them Using Hyperlinks

It is pretty rare to have an Excel table that you don't need to apply a whole subset of filters to in order to gain your insights.

So instead of manually clicking and selecting certain values, why not create something like a hyperlink that applies all the filters you need in one click.

This is sort of like how a web application would be written where you just click on what you want to see and then the underlying data is filter to meet those criteria. So let's get into it. I have been doing this a while but came up with these little scripts to make it faster to drop them into new workbooks or projects.

After you have taken a read and copied all this code into your VBA Modules you can create a hyperlink on a cell and name it after the name of the module. In this case I have only created one filtered macro called GoToActiveSalesforceUsers which is going to jump over to my User worksheet and filter the User table by the IsActive = TRUE and ProfileUserLicenseName = Salesforce. It will then look at the columns I want to view and hide all other columns. My table has about 60 columns so for this simple report I only want to see a small number of the important columns.

When I head back to my main worksheet (Sheet1) all the autofilters are reset and the columns are no longer hidden.

There is also a Worksheet function that, when click the hyperlink, checks that a sub procedure exists that matches the value of the link you clicked (with 'GoTo' prepended).

Functions

Option Explicit

Function GetColumnNumber(ColumnName As String, HeaderRow As Range) As Integer

  GetColumnNumber = Application.WorksheetFunction.Match(ColumnName, HeaderRow, 0)

End Function

TableFilters

Option Explicit

Global wb As Workbook
Global ws As Worksheet
Global table As ListObject
Global headers As Range
Global sThisFinancialYear As String
Global ShowColumns() As String

Sub init(ws As Worksheet)

  Set table = ws.ListObjects(ws.Name)
  Set headers = table.HeaderRowRange

End Sub

Sub ClearAllFilters()

  Set wb = ThisWorkbook
    
  For Each ws In wb.Worksheets
    On Error Resume Next
    ' Debug.Print "Resetting Worksheet - " & ws.Name
    ws.ShowAllData
    ws.Cells.EntireColumn.Hidden = False
  Next ws
    
  Debug.Print Now() & " - All Worksheet Filters have been Reset"

End Sub

Sub GoToActiveSalesforceUsers()
  
  Set ws = ThisWorkbook.Sheets("User")
  Call init(ws)
    
  ws.Activate
   
  With table.Range
    .AutoFilter Field:=GetColumnNumber("IsActive", headers), Criteria1:="FALSE"
    .AutoFilter Field:=GetColumnNumber("ProfileUserLicenseName", headers), Criteria1:="Salesforce"
  End With
  
  ws.Cells(1, 1).Select
  
  Call TableFieldsAndSort.DefaultUser(ws, table)

End Sub

TableFieldsAndSort

Option Explicit

Sub OnlyShowColumns(wsName As String, Columns As Variant)
  
  Dim i As Integer
  
  For i = LBound(Columns) To UBound(Columns)
    If Columns(i) <> "" Then
      Range(wsName & "[[#Headers],[" & Columns(i) & "]]").Select
      Selection.EntireColumn.Hidden = False
    End If
  Next i
  Range("A1").Select
    
End Sub

Sub Sort(wsName As String, Field As String, Optional Descending As Boolean)
  
  ' xlAscending and xlDescending are constants of 1 and 2
  Dim Order As Integer: Order = 1: If Descending Then Order = 2

  With table.Sort
    .SortFields.Clear
    .SortFields.Add Key:=Range(ws.Name & "[[#All],[" & Field & "]]"), Order:=Order
    .Apply
  End With
  
End Sub

Sub DefaultUser(ws As Worksheet, table As ListObject)

  ws.Cells.EntireColumn.Hidden = True
  
  ShowColumns = Split("" & _
    "Id," & _
    "CreatedDate," & _
    "Name," & _
    "Email,"
    "IsActive," & _
    "ProfileUserLicenseName," & _
    "," & _
    "," & _
    "," & _
"" _
  , ",")
  
  Call OnlyShowColumns(ws.Name, ShowColumns)
  Call Sort(ws.Name, "Email")

End Sub

Sheet1

Option Explicit

Private Sub Worksheet_Activate()

  Call TableFilters.ClearAllFilters

End Sub

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)

  Dim sProcName As String: sProcName = "GoTo" & Replace(Target.Range.Value2, " ", "")

    If checkProcName(ThisWorkbook, "TableFilters", sProcName) Then
      Application.Run "TableFilters" & "." & "GoTo" & Replace(Target.Range.Value2, " ", "")
    Else
      MsgBox "Filter definition not found"
    End If
End Sub

Function checkProcName(wBook As Workbook, sModuleName As String, sProcName As String) As Boolean
' ===========================================================================
' Found on http://www.cpearson.com at http://www.cpearson.com/excel/vbe.aspx
' then modified
'
' USAGE:
' to check if a procedure exists, call 'checkProcName' passing
' in the target workbook (which should be open), the Module,
' and the procedure name
'
' ===========================================================================
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim LineNum As Integer

Dim ProcName As String
Dim ProcKind As VBIDE.vbext_ProcKind

    checkProcName = False

    Set VBProj = wBook.VBProject
    Set VBComp = VBProj.VBComponents(sModuleName)
    Set CodeMod = VBComp.CodeModule

    With CodeMod
        LineNum = .CountOfDeclarationLines + 1
        Do Until LineNum >= .CountOfLines
            ProcName = .ProcOfLine(LineNum, ProcKind)
            If ProcName = sProcName Then
                checkProcName = True
                Exit Do
            End If
            Debug.Print ProcName
            LineNum = .ProcStartLine(ProcName, ProcKind) + .ProcCountLines(ProcName, ProcKind) + 1
        Loop
    End With


End Function

Function ProcKindString(ProcKind As VBIDE.vbext_ProcKind) As String
    Select Case ProcKind
        Case vbext_pk_Get
            ProcKindString = "Property Get"
        Case vbext_pk_Let
            ProcKindString = "Property Let"
        Case vbext_pk_Set
            ProcKindString = "Property Set"
        Case vbext_pk_Proc
            ProcKindString = "Sub Or Function"
        Case Else
            ProcKindString = "Unknown Type: " & CStr(ProcKind)
    End Select
End Function