The following macros are for use with the filters in the heading cells of named Excel tables. Each named table is a ListObject, and has its own AutoFilter property. There can be multiple List AutoFilters on a single worksheet.

Also see: Excel Worksheet AutoFilter VBA and Excel AutoFilter Basics

Show All Records

The following macro shows all records in List 1 on the active sheet, if a filter has been applied.

Sub ShowAllRecordsList1()
'shows all records in list 1, 
'   if filters were applied
Dim Lst As ListObject
Dim ws As Worksheet
Set ws = ActiveSheet
Set Lst = ws.ListObjects(1)

  With Lst.AutoFilter
    If .FilterMode Then
      .ShowAllData
    End If
  End With
End Sub

Clear Filters Selected Columns

Use the following macro to clear the filters on all the selected columns in the Excel Table.

For example, in this table, there are filters on solumns E, F and G. Cells are selected in columns F and G, so only those filters will be cleared.

Note: In the sample workbook, this macro, ClearFilterColSel, runs on the keyboard shortcut:

Ctrl + Shift + C

Sub ClearFilterColSel()
'shortcut Ctrl+Shift+C
'clears filters in selected columns
Dim myList As ListObject
Dim myDBR As Range
Dim mySel As Range
Dim myInt As Range
Dim c As Range
Dim SheetCol As Long
Dim StartCol As Long
Dim FltrCol As Long
Dim myMsg As String

myMsg = "Could not clear filters" _
    & vbCrLf _
    & "in selected columns"

On Error Resume Next
Set mySel = Selection
Set myList = mySel.Cells(1).ListObject
On Error GoTo errHandler

If myList Is Nothing Then
  myMsg = "Select a table cell" _
    & vbCrLf _
    & "and try again"
  GoTo errHandler
End If

Set myDBR = myList.DataBodyRange
StartCol = myDBR.Columns(1).Column

For Each c In mySel
  On Error Resume Next
    Set myInt = _
      Application.Intersect(c, myDBR)
  On Error GoTo errHandler
  If myInt Is Nothing Then
    GoTo errHandler
  End If
  
  SheetCol = c.Column
  FltrCol = SheetCol - StartCol + 1
  myList.Range.AutoFilter _
      Field:=FltrCol
Next c
exitHandler:
  Set myList = Nothing
  Exit Sub
errHandler:
  MsgBox myMsg
  Resume exitHandler
End Sub

Turn On List AutoFilter

Use the following Excel AutoFilter VBA code to turn on an Excel AutoFilter in List 1 on the active sheet.

Sub TurnAutoFilterOnList1()
'turn on AutoFilter for List 1
Dim Lst As ListObject
Set Lst = ActiveSheet.ListObjects(1)
    Lst.ShowAutoFilter = True

End Sub

Turn Off List AutoFilter

Use the following macro to turn off an Excel AutoFilter in List 1 on the active sheet.

Sub TurnAutoFilterOffList1()
'turn off AutoFilter in List 1
Dim Lst As ListObject
Set Lst = ActiveSheet.ListObjects(1)
  
Lst.ShowAutoFilter = False

End Sub

Count List AutoFilters

To count all the Lists and Named Tables on a worksheet, where AutoFilters are active, you can use the following code.

Sub CountListAutoFilters()
'counts list autofilters even if all arrows are hidden

Dim Lst As ListObject
Dim i As Long
i = 0

For Each Lst In ActiveSheet.ListObjects
    If Lst.ShowAutoFilter = True Then
    i = i + 1
    End If
Next Lst
Debug.Print "List AutoFilters: " & i
End Sub

Hide All List AutoFilter Arrows Except One

Perhaps you want users to filter only one of the columns in List 1. The following Excel AutoFilter VBA procedure hides the arrows for all columns except the second column in List 1

Sub HideArrowsList1()
'hides all arrows except list 1 column 2
Dim Lst As ListObject
Dim c As Range
Dim i As Integer
Application.ScreenUpdating = False

Set Lst = ActiveSheet.ListObjects(1)
i = 1

For Each c In Lst.HeaderRowRange
 If i <> 2 Then
    Lst.Range.AutoFilter Field:=i, _
      VisibleDropDown:=False
 Else
     Lst.Range.AutoFilter Field:=i, _
      VisibleDropDown:=True
 End If
 i = i + 1
Next

Application.ScreenUpdating = True
End Sub

Hide List AutoFilter Arrows Specific Columns

In other cases, you might want to hide the arrows on specific columns, and leave all the other arrows visible. The following procedure hides the arrows for columns 1, 3 and 4 in List 2.

Sub HideSpecifiedArrowsList2()
'hides arrows in specified columns in List 2
Dim Lst As ListObject
Dim c As Range
Dim i As Integer
Application.ScreenUpdating = False

Set Lst = ActiveSheet.ListObjects(2)
i = 1

For Each c In Lst.HeaderRowRange
 Select Case i
 Case 1, 3, 4
    Lst.Range.AutoFilter Field:=i, _
      Visibledropdown:=False
 Case Else
     Lst.Range.AutoFilter Field:=i, _
      Visibledropdown:=True
 End Select
 i = i + 1
Next

Application.ScreenUpdating = True
End Sub

Show All List AutoFilter Arrows

To show all the arrows in List 1, you can use the following Excel AutoFilter VBA code:

Sub ShowArrowsList1()
Dim Lst As ListObject
Dim c As Range
Dim i As Integer
Application.ScreenUpdating = False

Set Lst = ActiveSheet.ListObjects(1)
i = 1

For Each c In Lst.HeaderRowRange
  Lst.Range.AutoFilter Field:=i, _
    Visibledropdown:=True
  i = i + 1
Next

Application.ScreenUpdating = True
End Sub

Show Current Filter Info

Select a cell in a named Excel table that has filters applied. Then, run the ActiveListFilterInfo macro, to see a message box, with details on the filters that have been applied.

message box shows filter information

This macro will work correctly on a worksheet that has a single named Excel table, or multiple named Excel tables.

NOTE: The message box shows "Unknown" for columns where items were selected from the' Search box, or in the item check list.

Sub ActiveListFilterInfo()
'show current filter settings
Dim Lst As ListObject
Dim LstHd As Range
Dim c As Range
Dim i As Integer
Dim ListCols As Long
Dim afCount As Long
Dim myLst As ListObject

Dim myFilt As Filter
Dim afCrit1 As String
Dim afCrit2 As String
Dim afOp As String
Dim lngOp As Long
Dim afMsg As String

Application.ScreenUpdating = False
On Error Resume Next
Set Lst = ActiveCell.ListObject
If Lst Is Nothing Then
  MsgBox "Select cell in list," _
    & vbCrLf _
    & "then try again"
  Exit Sub
End If

If Lst.ShowAutoFilter = False Then
  MsgBox "No active filters applied"
  Exit Sub
End If

Set LstHd = Lst.HeaderRowRange
ListCols = LstHd.Columns.Count

For i = 1 To ListCols
  Set myFilt = Lst.AutoFilter.Filters.Item(i)
  If Not myFilt.On Then
    'do nothing
  Else
    afMsg = afMsg & _
      Format(i, "000") & ") " _
      & LstHd.Cells(i).Value _
      & ":  "
    afCrit1 = myFilt.Criteria1
    afCrit2 = myFilt.Criteria2
    lngOp = myFilt.Operator
    Select Case lngOp
      Case xlAnd: afOp = " AND "
      Case xlOr: afOp = " OR "
      Case Else:  afOp = ""
    End Select
    If afCrit1 = "" Then _
        afCrit1 = "Unknown"
    afMsg = afMsg & afCrit1 _
        & afOp & afCrit2
    afCount = afCount + 1
    afMsg = afMsg & vbCrLf
  End If
Next i

Application.ScreenUpdating = True

If afCount = 1 Then
  MsgBox "There is 1 filtered column:" _
    & vbCrLf & vbCrLf & afMsg
Else
  MsgBox "There are " & afCount _
    & " filtered columns:" _
    & vbCrLf & vbCrLf & afMsg
End If

End Sub

Copy Filtered List Rows Without Headings

The following macro copies the filtered rows, but not the headings, from List1 on the active sheet, to a new worksheet.

Sub CopyFilteredRowsOnlyList1()
Dim wsL As Worksheet
Dim ws As Worksheet
Dim rng As Range
Dim rng2 As Range
Dim Lst As ListObject

Application.ScreenUpdating = False
Set wsL = ActiveSheet
Set Lst = wsL.ListObjects(1)

With Lst.AutoFilter.Range
 On Error Resume Next
   Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
       .SpecialCells(xlCellTypeVisible)
 On Error GoTo 0
End With
If rng2 Is Nothing Then
   MsgBox "No data to copy"
Else
   Set ws = Sheets.Add
   Set rng = Lst.AutoFilter.Range
   'copy rows without headings
   rng.Offset(1, 0).Resize(rng.Rows.Count - 1) _
    .SpecialCells(xlCellTypeVisible).Copy _
     Destination:=ws.Range("A1")
End If
   
Application.ScreenUpdating = True

End Sub

Copy Filtered List Rows With Headings

The following macro copies the filtered rows, and the headings, from List1 on the active sheet, to a new worksheet.

Sub CopyFilteredRowsAndHeadingsList1()
Dim wsL As Worksheet
Dim ws As Worksheet
Dim rng As Range
Dim rng2 As Range
Dim Lst As ListObject

Application.ScreenUpdating = False
Set wsL = ActiveSheet
Set Lst = wsL.ListObjects(1)

With Lst.AutoFilter.Range
 On Error Resume Next
   Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
       .SpecialCells(xlCellTypeVisible)
 On Error GoTo 0
End With
If rng2 Is Nothing Then
   MsgBox "No data to copy"
Else
   Set ws = Sheets.Add
   Set rng = Lst.AutoFilter.Range
   'copy rows with headings
   rng.SpecialCells(xlCellTypeVisible).Copy _
     Destination:=ws.Range("A1")
End If
   
Application.ScreenUpdating = True

End Sub

Count Visible List Rows

With this Excel AutoFilter VBA sample code, you can display a message that shows a count of the rows that are visible after a filter has been applied:

show message with row count

Sub CountVisibleRowsList1()
Dim Lst As ListObject
Set Lst = ActiveSheet.ListObjects(1)

Dim rng As Range
Set rng = Lst.AutoFilter.Range

MsgBox rng.Columns(1). _
   SpecialCells(xlCellTypeVisible).Count - 1 _
   & " of " & rng _
   .Rows.Count - 1 & " Records"
End Sub

Download the Sample File

To see all the macros from this page, download the List AutoFilter Macros workbook. The zipped file is in xlsm format, and contains macros. Be sure to enable macros when you open the workbook, if you want to test the macros.

Excel List AutoFilter Macros

Excel List AutoFilters