view · edit · history · print

Excel AutoFilter Visibility

why & what?

  • more visible then the simple small button icon
  • indicator in other fields
  • indicator using conditional formatting
  • indication using formula without VBA
  • indication of invisible rows, hidden rows

methods

  • Formula with counter using COUNTA & SUBTOTAL (no VBA, see sample in DispCriteria comments, may not be able to identify individual columns. this is just a yes/no answer if a filter exists)
  • VBA Function DispCriteria, Display Filter Criteria (least reliable)
  • VBA Function GetColumns, Get Column letters having a filter, else return "*" (good for single field overview)
  • VBA Function IsFiltered, if column Is Filtered return "!", else "*" (good for conditional format in auto filter header)
  • https://www.extendoffice.com/documents/excel/4659-excel-highlight-column-header-if-filtered.html
  • VBA routine HighLightFilterTitle, will highlight the existing filter.

Function DispCriteria(Rng As Range) As String
    ' Display Filter Criteria

    ' parameter: Range, select applicable column for dynamic update
    ' sample: =DispCriteria(J:J)
    ' result: ">50" or "=TRUE" (good for booleans or small number filters)
    ' issue: criteria are not always picked-up completely

    ' note:
        'if you just want a count of filtered items you can better use a formula
        'sample: =COUNTA(I$2:I$22)-SUBTOTAL(103,I$2:I$22)

    Dim Filter As String

    Filter = ""
    On Error GoTo Done
    With Rng.Parent.AutoFilter
        If Intersect(Rng, .Range) Is Nothing Then GoTo Done
        With .Filters(Rng.Column - .Range.Column + 1)
            If Not .On Then GoTo Done
            Filter = .Criteria1
            'criteria may be empty
            Select Case .Operator
                Case xlAnd
                    Filter = Filter & " AND " & .Criteria2
                Case xlOr
                    Filter = Filter & " OR " & .Criteria2
            End Select
        End With
    End With
Done:
    'criteria are not always picked-up completely
    If Filter = "" Then
         Filter = "?"
    End If
    DispCriteria = Filter
End Function

 
Function GetColumns(Rng As Range) As String
    ' Get Column letters having a filter, else return "*"

    ' parameter: Range, select first filtered column for dynamic update
    ' sample: =GetColumns(A:A)
    ' result: ,E,H,J,AA (=4 columns have filters)

    Dim Sht As Worksheet
    Dim i As Long
    Dim FList As String
    Dim ColumnNumber As Long
    Dim ColumnLetter As String

    FList = ""
    Set Sht = ActiveSheet

    With Sht.AutoFilter
       For i = 1 To .Filters.Count
          If .Filters(i).On Then
             ColumnNumber = .Range(1, i).Column
             ColumnLetter = Split(Cells(1, ColumnNumber).Address, "$")(1)
             FList = FList & "," & ColumnLetter
          End If
       Next i
    End With
    If FList = "" Then
         FList = "*"
    End If
    GetColumns = FList
End Function

 
Function IsFiltered(Rng As Range) As String
    ' if column Is Filtered return "!", else "*"

    ' parameter: Range, select applicable column for dynamic update
    ' advantage: can also be used in conditional format using formula...
    ' sample: =IsFiltered(C:C)="!"

    Dim Filter As String

    Filter = ""
    On Error GoTo Done
    With Rng.Parent.AutoFilter
        If Intersect(Rng, .Range) Is Nothing Then GoTo Done
        With .Filters(Rng.Column - .Range.Column + 1)
            If Not .On Then GoTo Done
            Filter = "!"
        End With
    End With
Done:
    If Filter = "" Then
         Filter = "*"
    End If
    IsFiltered = Filter
End Function

 
Sub HighLightFilterTitle()
    Dim xRg As Range
    Dim xPos As Range
    Dim I As Integer
    Dim xCount As Long
    Dim xRgCol As Long
    Dim xAddress As String
    Dim xFilterCount As Long
    On Error Resume Next

    'remember original position
    Set xPos = ActiveCell

    xAddress = ActiveWindow.RangeSelection.Address
    'MsgBox ("select filter row")
    'Set xRg = Application.InputBox("Please select the first cell of the table range:", "KuTools For Excel", xAddress, , , , , 8)
    ' assuming the filter is on row 1, going to pos a1 to have the full row
    Set xRg = Range("A1")
    'Set xRg = ActiveCell
    'Set xRg = Cells(ActiveCell.Row, 1)

    'do nothing if there is no autofilter
    If xRg.Parent.AutoFilter Is Nothing Then
        MsgBox ("No autofilter found!" & Chr(13) & "If you use a table with filter, a cell in the table may need to be selected.")
        Exit Sub
    End If

    ' assuming the filter is on row 1
    Rows("1:1").Select
    'ActiveCell.Rows.Select
    'ActiveCell.EntireRow.Select

    ' remove all filter highlights
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
'    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
'    Selection.Borders(xlEdgeTop).LineStyle = xlNone
'    Selection.Borders(xlEdgeRight).LineStyle = xlNone
'    Selection.Borders(xlInsideVertical).LineStyle = xlNone
'    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

    If xRg Is Nothing Then Exit Sub
    xRg.Select
    With xRg(1).Parent.AutoFilter
        xFilterCount = .Range.Columns.Count
        xRgCol = xRg.Offset(1).Column - .Range.Column + 1
        For I = xRgCol To xFilterCount
            xCount = xRg.Offset(, I - xRgCol).Column - .Range.Column + 1
            With .Filters(xCount)
                If .On Then
                    ' hightlight that filter
                    'xRg.Offset(, I - xRgCol).Interior.Color = 16736553
                    xRg.Offset(, I - xRgCol).Borders(xlEdgeBottom).Weight = xlThick
                    xRg.Offset(, I - xRgCol).Borders(xlEdgeBottom).ColorIndex = 3
'                    xRg.Offset(, I - xRgCol).Borders(xlDiagonalUp).Weight = xlThick
'                    xRg.Offset(, I - xRgCol).Borders(xlDiagonalUp).ColorIndex = 3
'                    xRg.Offset(, I - xRgCol).Borders(xlDiagonalDown).Weight = xlThick
'                    xRg.Offset(, I - xRgCol).Borders(xlDiagonalDown).ColorIndex = 3
                End If
            End With
        Next
    End With
    'go back to original position
    xPos.Select
End Sub
admin · attr · attach · edit · history · print
Page last modified on January 25, 2019, at 07:39 AM