Print Excel Autofilter settings as VBA code to Immediate Window

Question

I had been searching for a way to print an Excel sheet's Autofilter settings to the Immediate window and I came up with this. This allows a developer to quickly convert an end user's filter settings to VBA code. I would appreciate feedback from anyone who cares to test the code.

Option Explicit
Public ws As Worksheet
Public wsn As String
Public MyCrit As Variant
Public FirstCritRow As Long
Public MiddleCritRow As Long
Public LastCritRow As Long
Public c As Long
Public MyRank As Double
Sub PrintFilters()
'Peter Domanico, November 2017 - January 2018
'Prints Excel Autofilter settings as VBA code to Immediate Window
'This file contains 3 scripts. use this code in own module.
'Assign the primary script (PrintFilters) to Excel button or shortcut key
'Primary script (PrintFilters) calls subscripts TopTenSub and BottomTenSub
'performance
 Application.ScreenUpdating = False
 Application.DisplayAlerts = False
'sheet dims
 Set ws = ActiveSheet '<~leave out "ThisWorkbook": causes errors with personal macro workbook
 wsn = ws.Name
'rows and columns
 Dim LastRow As Long
 Dim AllRows As Long
 Dim DataRows As Long
 Dim LastCol As Long
 LastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
 AllRows = ws.UsedRange.Rows.Count
 DataRows = AllRows - 1
 LastCol = ws.UsedRange.Columns.Count
'for use in xlTop10Items / xlBottom10Items
 Dim VisRows As Long
 VisRows = Application.WorksheetFunction.Subtotal(3, Range("A2:A" & LastRow))
'for use in xlFilterValues
 Dim CritString As String
 Dim AllCrit As Variant
 Dim CritVar As Variant
'for use in xlFilterCellColor
 Dim CondishCount As Long
 Dim ClrString As String
'misc dims
 Dim FltrCt As Long
 'begin main procedure
 FltrCt = 0 '<~ keeps count of active filters
 For c = 1 To LastCol '<~loop through each column
 On Error Resume Next '<~error handling
 With ws.AutoFilter.Filters(c) '<~uses filtered range only
 Select Case .Operator '<~detects operator type by value
 Case Is = 0 '<~Equals
 FltrCt = FltrCt + 1
 If FltrCt = 1 Then Debug.Print "With " & "Sheets(" & Chr(34) & wsn & Chr(34) & Chr(41) & ".UsedRange"
 Debug.Print vbTab & ".Autofilter Field:=" & c & Chr(44) & "Criteria1:=" & Chr(34) & .Criteria1 & Chr(34)
 Case Is = 1 '<~xlAnd
 FltrCt = FltrCt + 1
 If FltrCt = 1 Then Debug.Print "With " & "Sheets(" & Chr(34) & wsn & Chr(34) & Chr(41) & ".UsedRange"
 Debug.Print vbTab & ".Autofilter Field:=" & c & Chr(44) & "Criteria1:=" & Chr(34) & .Criteria1 & Chr(34) & Chr(44) & "Operator:=xlAnd" & Chr(44) & ("Criteria2:=" & Chr(34) & .Criteria2 & Chr(34))
 Case Is = 2 '<~xlOr
 FltrCt = FltrCt + 1
 If FltrCt = 1 Then Debug.Print "With " & "Sheets(" & Chr(34) & wsn & Chr(34) & Chr(41) & ".UsedRange"
 Debug.Print vbTab & ".Autofilter Field:=" & c & Chr(44) & "Criteria1:=" & Chr(34) & .Criteria1 & Chr(34) & Chr(44) & "Operator:=xlOr" & Chr(44) & ("Criteria2:=" & Chr(34) & .Criteria2 & Chr(34))
 Case Is = 3 'xlTop10Items
 FltrCt = FltrCt + 1
 If FltrCt = 1 Then Debug.Print "With " & "Sheets(" & Chr(34) & wsn & Chr(34) & Chr(41) & ".UsedRange"
 Debug.Print vbTab & ".Autofilter Field:=" & c & Chr(44) & "Criteria1:=" & VisRows & Chr(44) & "Operator:=xlTop10Items"
 Case Is = 4 'xlBottom10Items
 FltrCt = FltrCt + 1
 If FltrCt = 1 Then Debug.Print "With " & "Sheets(" & Chr(34) & wsn & Chr(34) & Chr(41) & ".UsedRange"
 Debug.Print vbTab & ".Autofilter Field:=" & c & Chr(44) & "Criteria1:=" & VisRows & Chr(44) & "Operator:=xlBottom10Items"
 Case Is = 5 'xlTop10Percent
 FltrCt = FltrCt + 1
 If FltrCt = 1 Then Debug.Print "With " & "Sheets(" & Chr(34) & wsn & Chr(34) & Chr(41) & ".UsedRange"
 MyCrit = Mid(.Criteria1, 3)
 Call TopTenSub
 Debug.Print vbTab & ".Autofilter Field:=" & c & Chr(44) & "Criteria1:=" & MyRank & Chr(44) & "Operator:=xlTop10Percent"
 Case Is = 6 'xlBottom10Percent
 FltrCt = FltrCt + 1
 If FltrCt = 1 Then Debug.Print "With " & "Sheets(" & Chr(34) & wsn & Chr(34) & Chr(41) & ".UsedRange"
 MyCrit = Mid(.Criteria1, 3)
 Call BottomTenSub
 Debug.Print vbTab & ".Autofilter Field:=" & c & Chr(44) & "Criteria1:=" & MyRank & Chr(44) & "Operator:=xlBottom10Percent"
 Case Is = 7 '<~xlFilterValues
 FltrCt = FltrCt + 1
 If FltrCt = 1 Then Debug.Print "With " & "Sheets(" & Chr(34) & wsn & Chr(34) & Chr(41) & ".UsedRange"
 For Each CritVar In .Criteria1
 AllCrit = AllCrit & Chr(44) & Chr(34) & Mid(CritVar, 2) & Chr(34)
 CritString = AllCrit
 CritString = Replace(CritString, Chr(44), "", 1, 1)
 Next
 Debug.Print vbTab & ".Autofilter Field:=" & c & Chr(44) & "Criteria1:=Array(" & CritString & ")," & "Operator:=xlFilterValues"
 AllCrit = Nothing
 Case Is = 8 '<~xlFilterCellColor
 FltrCt = FltrCt + 1
 If FltrCt = 1 Then Debug.Print "With " & "Sheets(" & Chr(34) & wsn & Chr(34) & Chr(41) & ".UsedRange"
 ClrString = ws.Cells(LastRow, c).Interior.Color '<~ filters by manually applied cell fill color
 Debug.Print vbTab & ".Autofilter Field:=" & c & Chr(44) & "Criteria1:=" & ClrString & Chr(44) & "Operator:=xlFilterCellColor"
 CondishCount = ws.Cells(LastRow, c).FormatConditions.Count
 If CondishCount > 0 Then Debug.Print Chr(39) & CondishCount & Chr(32) & "conditional formats detected in column" & Chr(32) & c
 Case Is = 9 '<~xlFilterFontColor
 FltrCt = FltrCt + 1
 If FltrCt = 1 Then Debug.Print "With " & "Sheets(" & Chr(34) & wsn & Chr(34) & Chr(41) & ".UsedRange"
 ClrString = ws.Cells(LastRow, c).Font.Color '<~ filters by manually applied cell fill color
 Debug.Print vbTab & ".Autofilter Field:=" & c & Chr(44) & "Criteria1:=" & ClrString & Chr(44) & "Operator:=xlFilterFontColor"
 Case Is = 11
 FltrCt = FltrCt + 1
 If FltrCt = 1 Then Debug.Print "With " & "Sheets(" & Chr(34) & wsn & Chr(34) & Chr(41) & ".UsedRange"
 MyCrit = .Criteria1
 If MyCrit = 33 Then MyCrit = "xlFilterAboveAverage"
 If MyCrit = 34 Then MyCrit = "xlFilterBelowAverage"
 Debug.Print vbTab & ".Autofilter Field:=" & c & Chr(44) & "Criteria1:=" & MyCrit & Chr(44) & "Operator:=xlFilterDynamic"
 End Select
 End With
 Next c
'close With statement
 If FltrCt > 0 Then Debug.Print "End With"
'performance and cleanup
 ws.Select
 Application.ScreenUpdating = True
 Application.DisplayAlerts = True
End Sub
Sub TopTenSub()
'set sheets
 Dim wb As Workbook
 Set wb = ActiveWorkbook
 Dim TempSheet As Worksheet
 Set ws = wb.Sheets(wsn)
 Dim LastRow As Long
 'duplicate source sheet
 On Error Resume Next
 wb.Sheets("PeteDTempData").Delete
 wb.Sheets(wsn).Copy After:=wb.Sheets(wsn)
 wb.ActiveSheet.Name = "PeteDTempData"
 Set TempSheet = wb.Sheets("PeteDTempData")
 'sort
 TempSheet.UsedRange.AutoFilter
 LastRow = TempSheet.Cells(Rows.Count, 1).End(xlUp).Row
 TempSheet.Sort.SortFields.Add Key:=Range("A2:A" & LastRow) _
 , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
 With TempSheet.Sort
 .SetRange Range("A1:A" & LastRow)
 .Header = xlYes
 .MatchCase = False
 .Orientation = xlTopToBottom
 .SortMethod = xlPinYin
 .Apply
 End With
'number range
 Dim j As Long
 Dim i As Long
 Dim CountCol As Long
 CountCol = TempSheet.UsedRange.Columns.Count + 1
 j = 1
 For i = 2 To LastRow
 TempSheet.Cells(i, CountCol) = j
 j = j + 1
 Next i
'find first MyCrit
 FirstCritRow = TempSheet.Columns(c).Find(What:=MyCrit, LookAt:=xlWhole).Row
'find last MyCrit
 LastCritRow = TempSheet.Columns(c).Find(What:=MyCrit, LookAt:=xlWhole, SearchDirection:=xlPrevious).Row
'find middle MyCrit
 MiddleCritRow = WorksheetFunction.Average(FirstCritRow, LastCritRow)
 MiddleCritRow = Round(MiddleCritRow, 0)
'calculate percent
 With TempSheet
 MyRank = .Cells(MiddleCritRow, CountCol) / (LastRow - 1)
 MyRank = MyRank * 100
 MyRank = Round(MyRank, 0)
 End With
'delete temp sheet
 TempSheet.Delete
 ws.Select
End Sub
Sub BottomTenSub()
'set sheets
 Dim wb As Workbook
 Set wb = ActiveWorkbook
 Dim TempSheet As Worksheet
 Set ws = wb.Sheets(wsn)
 Dim LastRow As Long
 'duplicate source sheet
 On Error Resume Next
 wb.Sheets("PeteDTempData").Delete
 wb.Sheets(wsn).Copy After:=wb.Sheets(wsn)
 wb.ActiveSheet.Name = "PeteDTempData"
 Set TempSheet = wb.Sheets("PeteDTempData")
 'sort
 TempSheet.UsedRange.AutoFilter
 LastRow = TempSheet.Cells(Rows.Count, 1).End(xlUp).Row
 TempSheet.Sort.SortFields.Add Key:=Range("A2:A" & LastRow) _
 , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
 With TempSheet.Sort
 .SetRange Range("A1:A" & LastRow)
 .Header = xlYes
 .MatchCase = False
 .Orientation = xlTopToBottom
 .SortMethod = xlPinYin
 .Apply
 End With
'number range
 Dim j As Long
 Dim i As Long
 Dim CountCol As Long
 CountCol = TempSheet.UsedRange.Columns.Count + 1
 j = 1
 For i = 2 To LastRow
 TempSheet.Cells(i, CountCol) = j
 j = j + 1
 Next i
'find first MyCrit
 FirstCritRow = TempSheet.Columns(c).Find(What:=MyCrit, LookAt:=xlWhole).Row
'find last MyCrit
 LastCritRow = TempSheet.Columns(c).Find(What:=MyCrit, LookAt:=xlWhole, SearchDirection:=xlPrevious).Row
'find middle MyCrit
 MiddleCritRow = WorksheetFunction.Average(FirstCritRow, LastCritRow)
 MiddleCritRow = Round(MiddleCritRow, 0)
'calculate percent
 With TempSheet
 MyRank = .Cells(MiddleCritRow, CountCol) / (LastRow - 1)
 MyRank = 1 - MyRank
 MyRank = MyRank * 100
 MyRank = Round(MyRank, 0)
 End With
'delete temp sheet
 TempSheet.Delete
 ws.Select
End Sub

Answer 1

Printing Excel Autofilter setting is a great idea. The problem with your implementation is that too much of it is hardcoded.

'Range("A2:A" & LastRow)' needs to be fully-qualified ws. Range("A2:A" & LastRow)

There are a lot of caveats to the Autofilter. Here is the foundation that I would use:

Sub PrintFilters(ws As Worksheet)
 Dim AutoFilter1 As AutoFilter
 Dim Criteria1 As String, Criteria2 As String, Operator1 As String
 Dim FieldIndex As Long
 Set AutoFilter1 = ws.AutoFilter
 If Not AutoFilter1 Is Nothing Then
 For FieldIndex = 1 To AutoFilter1.Filters.Count
 If AutoFilter1.Filters(FieldIndex).On Then
 With AutoFilter1.Filters(FieldIndex)
 On Error Resume Next
 Criteria1 = getCriteria(.Criteria1)
 Criteria2 = getCriteria(.Criteria2)
 Operator1 = getXlAutoFilterOperator(.Operator)
 On Error GoTo 0
 End With
 End If
 Next
 End If
End Sub
Function getCriteria(Criteria As Variant) As String
 On Error Resume Next
 ' Criteria can return either a scalar value or an Array. You'll have to handle both cases
 On Error GoTo 0
End Function
Function getXlDynamicFilterCriteria(Index As Long)
 Dim s As String
 Select Case Index
 Case 33: s = "xlFilterAboveAverage" 'Filter all above-average values.
 Case 24: s = "xlFilterAllDatesInPeriodApril" 'Filter all dates in April.
 Case 28: s = "xlFilterAllDatesInPeriodAugust" 'Filter all dates in August.
 Case 32: s = "xlFilterAllDatesInPeriodDecember" 'Filter all dates in December.
 Case 22: s = "xlFilterAllDatesInPeriodFebruray" 'Filter all dates in February.
 Case 21: s = "xlFilterAllDatesInPeriodJanuary" 'Filter all dates in January.
 Case 27: s = "xlFilterAllDatesInPeriodJuly" 'Filter all dates in July.
 Case 26: s = "xlFilterAllDatesInPeriodJune" 'Filter all dates in June.
 Case 23: s = "xlFilterAllDatesInPeriodMarch" 'Filter all dates in March.
 Case 25: s = "xlFilterAllDatesInPeriodMay" 'Filter all dates in May.
 Case 31: s = "xlFilterAllDatesInPeriodNovember" 'Filter all dates in November.
 Case 30: s = "xlFilterAllDatesInPeriodOctober" 'Filter all dates in October.
 Case 17: s = "xlFilterAllDatesInPeriodQuarter1" 'Filter all dates in Quarter1.
 Case 18: s = "xlFilterAllDatesInPeriodQuarter2" 'Filter all dates in Quarter2.
 Case 19: s = "xlFilterAllDatesInPeriodQuarter3" 'Filter all dates in Quarter3.
 Case 20: s = "xlFilterAllDatesInPeriodQuarter4" 'Filter all dates in Quarter4.
 Case 29: s = "xlFilterAllDatesInPeriodSeptember" 'Filter all dates in September.
 Case 34: s = "xlFilterBelowAverage" 'Filter all below-average values.
 Case 8: s = "xlFilterLastMonth" 'Filter all values related to last month.
 Case 11: s = "xlFilterLastQuarter" 'Filter all values related to last quarter.
 Case 5: s = "xlFilterLastWeek" 'Filter all values related to last week.
 Case 14: s = "xlFilterLastYear" 'Filter all values related to last year.
 Case 9: s = "xlFilterNextMonth" 'Filter all values related to next month.
 Case 12: s = "xlFilterNextQuarter" 'Filter all values related to next quarter.
 Case 6: s = "xlFilterNextWeek" 'Filter all values related to next week.
 Case 15: s = "xlFilterNextYear" 'Filter all values related to next year.
 Case 7: s = "xlFilterThisMonth" 'Filter all values related to the current month.
 Case 10: s = "xlFilterThisQuarter" 'Filter all values related to the current quarter.
 Case 4: s = "xlFilterThisWeek" 'Filter all values related to the current week.
 Case 13: s = "xlFilterThisYear" 'Filter all values related to the current year.
 Case 1: s = "xlFilterToday" 'Filter all values related to the current date.
 Case 3: s = "xlFilterTomorrow" 'Filter all values related to tomorrow.
 Case 16: s = "xlFilterYearToDate" 'Filter all values from today until a year ago.
 Case 2: s = "xlFilterYesterday" 'Filter all values related to yesterday.
 End Select
 getXlDynamicFilterCriteria = s
End Function
Function getXlAutoFilterOperator(Index As Long)
 Dim s As String
 Select Case Index
 Case 1: s = "xlAnd" 'Logical AND of Criteria1 and Criteria2.
 Case 4: s = "xlBottom10Items" 'Lowest-valued items displayed (number of items specified in Criteria1).
 Case 6: s = "xlBottom10Percent" 'Lowest-valued items displayed (percentage specified in Criteria1).
 Case 8: s = "xlFilterCellColor" 'Color of the cell
 Case 11: s = "xlFilterDynamic" 'Dynamic filter
 Case 9: s = "xlFilterFontColor" 'Color of the font
 Case 10: s = "xlFilterIcon" 'Filter icon
 Case 7: s = "xlFilterValues" 'Filter values
 Case 2: s = "xlOr" 'Logical OR of Criteria1 or Criteria2.
 Case 3: s = "xlTop10Items" 'Highest-valued items displayed (number of items specified in Criteria1).
 Case 5: s = "xlTop10Percent" 'Highest-valued items displayed (percentage specified in Criteria1).
 End Select
 getXlAutoFilterOperator = s
End Function

Answer 2

I have integrated some of Thomas's ideas here. I just noticed my code has trouble with arrays of dates, which I will need to work on. Generally speaking, this seems to work well.

Option Explicit
Public Ws As Worksheet
Public wsn As String
Public s As String
Public MyCrit As Variant
Public FirstCritRow As Long
Public MiddleCritRow As Long
Public LastCritRow As Long
Public c As Long
Public MyRank As Double
Sub PrintFilters()
'Peter Domanico, November 2017 - January 2018
'Prints Excel Autofilter settings as VBA code to Immediate Window
'This file contains 6 scripts. Use this code in own module.
'Assign the primary script (PrintFilters) to Excel button or shortcut key
'Primary script (PrintFilters) calls all other scripts
'performance
 Application.ScreenUpdating = False
 Application.DisplayAlerts = False
'sheet dims
 Set Ws = ActiveSheet '<~leave out "ThisWorkbook": causes errors with personal macro workbook
 wsn = Ws.Name
'rows and columns
 Dim LastRow As Long
 Dim LastCol As Long
 LastRow = Ws.Cells(Rows.Count, 1).End(xlUp).Row
 LastCol = Ws.UsedRange.Columns.Count
'for use in xlFilterValues
 Dim CritString As String
 Dim AllCrit As Variant
 Dim CritVar As Variant
'for use in xlFilterCellColor
 Dim CondishCount As Long
 Dim ClrString As String
'misc dims
 Dim FltrCt As Long
 'begin main procedure
 FltrCt = 0 '<~ keeps count of active filters
 For c = 1 To LastCol '<~loop through each column
 On Error Resume Next '<~error handling
 With Ws.AutoFilter.Filters(c) '<~uses filtered range only
 Select Case .Operator '<~detects operator type by value
 Case Is = 0 '<single filter value
 FltrCt = FltrCt + 1
 If FltrCt = 1 Then Debug.Print "With " & "Sheets(" & Chr(34) & wsn & Chr(34) & Chr(41) & ".UsedRange"
 Debug.Print vbTab & ".Autofilter Field:=" & c & Chr(44) & "Criteria1:=" & Chr(34) & .Criteria1 & Chr(34)
 Case Is = 1 '<~xlAnd
 FltrCt = FltrCt + 1
 If FltrCt = 1 Then Debug.Print "With " & "Sheets(" & Chr(34) & wsn & Chr(34) & Chr(41) & ".UsedRange"
 Debug.Print vbTab & ".Autofilter Field:=" & c & Chr(44) & "Criteria1:=" & Chr(34) & .Criteria1 & Chr(34) & Chr(44) & "Operator:=xlAnd" & Chr(44) & ("Criteria2:=" & Chr(34) & .Criteria2 & Chr(34))
 Case Is = 2 '<~xlOr
 FltrCt = FltrCt + 1
 If FltrCt = 1 Then Debug.Print "With " & "Sheets(" & Chr(34) & wsn & Chr(34) & Chr(41) & ".UsedRange"
 Debug.Print vbTab & ".Autofilter Field:=" & c & Chr(44) & "Criteria1:=" & Chr(34) & .Criteria1 & Chr(34) & Chr(44) & "Operator:=xlOr" & Chr(44) & ("Criteria2:=" & Chr(34) & .Criteria2 & Chr(34))
 Case Is = 3 'xlTop10Items
 FltrCt = FltrCt + 1
 MyCrit = Mid(.Criteria1, 3)
 Call TopTenItemSub
 If FltrCt = 1 Then Debug.Print "With " & "Sheets(" & Chr(34) & wsn & Chr(34) & Chr(41) & ".UsedRange"
 Debug.Print vbTab & ".Autofilter Field:=" & c & Chr(44) & "Criteria1:=" & MyRank & Chr(44) & "Operator:=xlTop10Items"
 Case Is = 4 'xlBottom10Items
 FltrCt = FltrCt + 1
 MyCrit = Mid(.Criteria1, 3)
 Call BottomTenItemSub
 If FltrCt = 1 Then Debug.Print "With " & "Sheets(" & Chr(34) & wsn & Chr(34) & Chr(41) & ".UsedRange"
 Debug.Print vbTab & ".Autofilter Field:=" & c & Chr(44) & "Criteria1:=" & MyRank & Chr(44) & "Operator:=xlBottom10Items"
 Case Is = 5 'xlTop10Percent
 FltrCt = FltrCt + 1
 If FltrCt = 1 Then Debug.Print "With " & "Sheets(" & Chr(34) & wsn & Chr(34) & Chr(41) & ".UsedRange"
 MyCrit = Mid(.Criteria1, 3)
 Call TopTenPercSub
 Debug.Print vbTab & ".Autofilter Field:=" & c & Chr(44) & "Criteria1:=" & MyRank & Chr(44) & "Operator:=xlTop10Percent"
 Case Is = 6 'xlBottom10Percent
 FltrCt = FltrCt + 1
 If FltrCt = 1 Then Debug.Print "With " & "Sheets(" & Chr(34) & wsn & Chr(34) & Chr(41) & ".UsedRange"
 MyCrit = Mid(.Criteria1, 3)
 Call BottomTenPercSub
 Debug.Print vbTab & ".Autofilter Field:=" & c & Chr(44) & "Criteria1:=" & MyRank & Chr(44) & "Operator:=xlBottom10Percent"
 Case Is = 7 '<~xlFilterValues
 Select Case IsDate(Ws.Cells(2, c))
 Case Is = True
 Debug.Print Chr(39) & "Unsupported date array found in column " & c & Chr(46) & Chr(32) & "Please inspect Autofilter manually" & Chr(46)
 GoTo DateBail
 End Select
 FltrCt = FltrCt + 1
 If FltrCt = 1 Then Debug.Print "With " & "Sheets(" & Chr(34) & wsn & Chr(34) & Chr(41) & ".UsedRange"
 For Each CritVar In .Criteria1
 AllCrit = AllCrit & Chr(44) & Chr(34) & Mid(CritVar, 2) & Chr(34)
 CritString = AllCrit
 CritString = Replace(CritString, Chr(44), "", 1, 1)
 Next
 Debug.Print vbTab & ".Autofilter Field:=" & c & Chr(44) & "Criteria1:=Array(" & CritString & ")," & "Operator:=xlFilterValues"
 AllCrit = Nothing
 Case Is = 8 '<~xlFilterCellColor
 FltrCt = FltrCt + 1
 CondishCount = Ws.Cells(LastRow, c).FormatConditions.Count
 If CondishCount > 0 Then Debug.Print Chr(39) & CondishCount & Chr(32) & "conditional format(s) detected in column" & Chr(32) & c & Chr(46) & Chr(32) & "Please inspect Autofilter manually" & Chr(46)
 If FltrCt = 1 Then Debug.Print "With " & "Sheets(" & Chr(34) & wsn & Chr(34) & Chr(41) & ".UsedRange"
 ClrString = Ws.Cells(LastRow, c).Interior.Color '<~ filters by manually applied cell fill color
 Debug.Print vbTab & ".Autofilter Field:=" & c & Chr(44) & "Criteria1:=" & ClrString & Chr(44) & "Operator:=xlFilterCellColor"
 Case Is = 9 '<~xlFilterFontColor
 FltrCt = FltrCt + 1
 CondishCount = Ws.Cells(LastRow, c).FormatConditions.Count
 If CondishCount > 0 Then Debug.Print Chr(39) & CondishCount & Chr(32) & "conditional format(s) detected in column" & Chr(32) & c & Chr(46) & Chr(32) & "Please inspect Autofilter manually" & Chr(46)
 If FltrCt = 1 Then Debug.Print "With " & "Sheets(" & Chr(34) & wsn & Chr(34) & Chr(41) & ".UsedRange"
 ClrString = Ws.Cells(LastRow, c).Font.Color '<~ filters by manually applied cell fill color
 Debug.Print vbTab & ".Autofilter Field:=" & c & Chr(44) & "Criteria1:=" & ClrString & Chr(44) & "Operator:=xlFilterFontColor"
 Case Is = 11 '<~xlFilterDynamic
 FltrCt = FltrCt + 1
 If FltrCt = 1 Then Debug.Print "With " & "Sheets(" & Chr(34) & wsn & Chr(34) & Chr(41) & ".UsedRange"
 MyCrit = .Criteria1
 Call DynamicSub
 Debug.Print vbTab & ".Autofilter Field:=" & c & Chr(44) & "Criteria1:=" & s & Chr(44) & "Operator:=xlFilterDynamic"
 Case Is = 12 '<~xlFilterNoFill
 FltrCt = FltrCt + 1
 CondishCount = Ws.Cells(LastRow, c).FormatConditions.Count
 If CondishCount > 0 Then Debug.Print Chr(39) & CondishCount & Chr(32) & "conditional format(s) detected in column" & Chr(32) & c & Chr(46) & Chr(32) & "Please inspect Autofilter manually" & Chr(46)
 If FltrCt = 1 Then Debug.Print "With " & "Sheets(" & Chr(34) & wsn & Chr(34) & Chr(41) & ".UsedRange"
 Debug.Print vbTab & ".Autofilter Field:=" & c & Chr(44) & "Operator:=xlFilterNoFill"
 Case Is = 13 '<~xlFilterAutomaticFontColor
 FltrCt = FltrCt + 1
 CondishCount = Ws.Cells(LastRow, c).FormatConditions.Count
 If CondishCount > 0 Then Debug.Print Chr(39) & CondishCount & Chr(32) & "conditional format(s) detected in column" & Chr(32) & c & Chr(46) & Chr(32) & "Please inspect Autofilter manually" & Chr(46)
 If FltrCt = 1 Then Debug.Print "With " & "Sheets(" & Chr(34) & wsn & Chr(34) & Chr(41) & ".UsedRange"
 Debug.Print vbTab & ".Autofilter Field:=" & c & Chr(44) & "Operator:=xlFilterAutomaticFontColor"
 End Select
 End With
DateBail:
 Next c
'close With statement and notify user
 Select Case FltrCt
 Case Is > 0
 Debug.Print "End With"
 MsgBox FltrCt & " supported filters detected", vbInformation, "See Immediate Window for code"
 End Select
'notify user if no filtered columns detected
 If FltrCt = 0 Then MsgBox "No filtered columns detected", vbInformation, "!!!"
'performance and cleanup
 Ws.Select
 Application.ScreenUpdating = True
 Application.DisplayAlerts = True
End Sub
Sub TopTenItemSub()
'set sheets
 Dim wb As Workbook
 Set wb = ActiveWorkbook
 Dim TempSheet As Worksheet
 Set Ws = wb.Sheets(wsn)
 Dim LastRow As Long
 'duplicate source sheet
 On Error Resume Next
 wb.Sheets("PeteDTempData").Delete
 wb.Sheets(wsn).Copy After:=wb.Sheets(wsn)
 wb.ActiveSheet.Name = "PeteDTempData"
 Set TempSheet = wb.Sheets("PeteDTempData")
 'sort
 TempSheet.UsedRange.AutoFilter
 LastRow = TempSheet.Cells(Rows.Count, c).End(xlUp).Row
 TempSheet.Sort.SortFields.Add Key:=Range(Cells(2, c), Cells(LastRow, c)), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
 With TempSheet.Sort
 .SetRange Range(Cells(1, c), Cells(LastRow, c))
 .Header = xlYes
 .MatchCase = False
 .Orientation = xlTopToBottom
 .SortMethod = xlPinYin
 .Apply
 End With
'number range
 Dim j As Long
 Dim i As Long
 Dim CountCol As Long
 CountCol = TempSheet.Cells(1, Columns.Count).End(xlToLeft).Column + 1
 j = 1
 For i = 2 To LastRow
 TempSheet.Cells(i, CountCol) = j
 j = j + 1
 Next i
'find first MyCrit
 FirstCritRow = TempSheet.Columns(c).Find(What:=MyCrit, LookAt:=xlWhole).Row
'calculate rank
 With TempSheet
 MyRank = FirstCritRow - 1
 End With
'delete temp sheet
 TempSheet.Delete
 Ws.Select
End Sub
Sub BottomTenItemSub()
'set sheets
 Dim wb As Workbook
 Set wb = ActiveWorkbook
 Dim TempSheet As Worksheet
 Set Ws = wb.Sheets(wsn)
 Dim LastRow As Long
 'duplicate source sheet
 On Error Resume Next
 wb.Sheets("PeteDTempData").Delete
 wb.Sheets(wsn).Copy After:=wb.Sheets(wsn)
 wb.ActiveSheet.Name = "PeteDTempData"
 Set TempSheet = wb.Sheets("PeteDTempData")
 'sort
 TempSheet.UsedRange.AutoFilter
 LastRow = TempSheet.Cells(Rows.Count, c).End(xlUp).Row
 TempSheet.Sort.SortFields.Add Key:=Range(Cells(2, c), Cells(LastRow, c)), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
 With TempSheet.Sort
 .SetRange Range(Cells(1, c), Cells(LastRow, c))
 .Header = xlYes
 .MatchCase = False
 .Orientation = xlTopToBottom
 .SortMethod = xlPinYin
 .Apply
 End With
'number range
 Dim j As Long
 Dim i As Long
 Dim CountCol As Long
 CountCol = TempSheet.Cells(1, Columns.Count).End(xlToLeft).Column + 1
 j = 1
 For i = 2 To LastRow
 TempSheet.Cells(i, CountCol) = j
 j = j + 1
 Next i
'find first MyCrit
 FirstCritRow = TempSheet.Columns(c).Find(What:=MyCrit, LookAt:=xlWhole).Row
'calculate rank
 With TempSheet
 MyRank = (LastRow - FirstCritRow) + 1
 End With
'delete temp sheet
 TempSheet.Delete
 Ws.Select
End Sub
Sub TopTenPercSub()
'set sheets
 Dim wb As Workbook
 Set wb = ActiveWorkbook
 Dim TempSheet As Worksheet
 Set Ws = wb.Sheets(wsn)
 Dim LastRow As Long
 'duplicate source sheet
 On Error Resume Next
 wb.Sheets("PeteDTempData").Delete
 wb.Sheets(wsn).Copy After:=wb.Sheets(wsn)
 wb.ActiveSheet.Name = "PeteDTempData"
 Set TempSheet = wb.Sheets("PeteDTempData")
 'sort
 TempSheet.UsedRange.AutoFilter
 LastRow = TempSheet.Cells(Rows.Count, c).End(xlUp).Row
 TempSheet.Sort.SortFields.Add Key:=Range(Cells(2, c), Cells(LastRow, c)), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
 With TempSheet.Sort
 .SetRange Range(Cells(1, c), Cells(LastRow, c))
 .Header = xlYes
 .MatchCase = False
 .Orientation = xlTopToBottom
 .SortMethod = xlPinYin
 .Apply
 End With
'number range
 Dim j As Long
 Dim i As Long
 Dim CountCol As Long
 CountCol = TempSheet.Cells(1, Columns.Count).End(xlToLeft).Column + 1
 j = 1
 For i = 2 To LastRow
 TempSheet.Cells(i, CountCol) = j
 j = j + 1
 Next i
'find first MyCrit
 FirstCritRow = TempSheet.Columns(c).Find(What:=MyCrit, LookAt:=xlWhole).Row
'find last MyCrit
 LastCritRow = TempSheet.Columns(c).Find(What:=MyCrit, LookAt:=xlWhole, SearchDirection:=xlPrevious).Row
'find middle MyCrit
 MiddleCritRow = WorksheetFunction.Average(FirstCritRow, LastCritRow)
 MiddleCritRow = Round(MiddleCritRow, 0)
'calculate percent
 With TempSheet
 MyRank = .Cells(MiddleCritRow, CountCol) / (LastRow - 1)
 MyRank = MyRank * 100
 MyRank = Round(MyRank, 0)
 End With
'delete temp sheet
 TempSheet.Delete
 Ws.Select
End Sub
Sub BottomTenPercSub()
'set sheets
 Dim wb As Workbook
 Set wb = ActiveWorkbook
 Dim TempSheet As Worksheet
 Set Ws = wb.Sheets(wsn)
 Dim LastRow As Long
 'duplicate source sheet
 On Error Resume Next
 wb.Sheets("PeteDTempData").Delete
 wb.Sheets(wsn).Copy After:=wb.Sheets(wsn)
 wb.ActiveSheet.Name = "PeteDTempData"
 Set TempSheet = wb.Sheets("PeteDTempData")
 'sort
 TempSheet.UsedRange.AutoFilter
 LastRow = TempSheet.Cells(Rows.Count, c).End(xlUp).Row
 TempSheet.Sort.SortFields.Add Key:=Range(Cells(2, c), Cells(LastRow, c)), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
 With TempSheet.Sort
 .SetRange Range(Cells(1, c), Cells(LastRow, c))
 .Header = xlYes
 .MatchCase = False
 .Orientation = xlTopToBottom
 .SortMethod = xlPinYin
 .Apply
 End With
'number range
 Dim j As Long
 Dim i As Long
 Dim CountCol As Long
 CountCol = TempSheet.Cells(1, Columns.Count).End(xlToLeft).Column + 1
 j = 1
 For i = 2 To LastRow
 TempSheet.Cells(i, CountCol) = j
 j = j + 1
 Next i
'find first MyCrit
 FirstCritRow = TempSheet.Columns(c).Find(What:=MyCrit, LookAt:=xlWhole).Row
'find last MyCrit
 LastCritRow = TempSheet.Columns(c).Find(What:=MyCrit, LookAt:=xlWhole, SearchDirection:=xlPrevious).Row
'find middle MyCrit
 MiddleCritRow = WorksheetFunction.Average(FirstCritRow, LastCritRow)
 MiddleCritRow = Round(MiddleCritRow, 0)
'calculate percent
 With TempSheet
 MyRank = .Cells(MiddleCritRow, CountCol) / (LastRow - 1)
 MyRank = 1 - MyRank
 MyRank = MyRank * 100
 MyRank = Round(MyRank, 0)
 End With
'delete temp sheet
 TempSheet.Delete
 Ws.Select
End Sub
Sub DynamicSub()
 Select Case MyCrit
 Case 33: s = "xlFilterAboveAverage" 'Filter all above-average values.
 Case 24: s = "xlFilterAllDatesInPeriodApril" 'Filter all dates in April.
 Case 28: s = "xlFilterAllDatesInPeriodAugust" 'Filter all dates in August.
 Case 32: s = "xlFilterAllDatesInPeriodDecember" 'Filter all dates in December.
 Case 22: s = "xlFilterAllDatesInPeriodFebruray" 'Filter all dates in February.
 Case 21: s = "xlFilterAllDatesInPeriodJanuary" 'Filter all dates in January.
 Case 27: s = "xlFilterAllDatesInPeriodJuly" 'Filter all dates in July.
 Case 26: s = "xlFilterAllDatesInPeriodJune" 'Filter all dates in June.
 Case 23: s = "xlFilterAllDatesInPeriodMarch" 'Filter all dates in March.
 Case 25: s = "xlFilterAllDatesInPeriodMay" 'Filter all dates in May.
 Case 31: s = "xlFilterAllDatesInPeriodNovember" 'Filter all dates in November.
 Case 30: s = "xlFilterAllDatesInPeriodOctober" 'Filter all dates in October.
 Case 17: s = "xlFilterAllDatesInPeriodQuarter1" 'Filter all dates in Quarter1.
 Case 18: s = "xlFilterAllDatesInPeriodQuarter2" 'Filter all dates in Quarter2.
 Case 19: s = "xlFilterAllDatesInPeriodQuarter3" 'Filter all dates in Quarter3.
 Case 20: s = "xlFilterAllDatesInPeriodQuarter4" 'Filter all dates in Quarter4.
 Case 29: s = "xlFilterAllDatesInPeriodSeptember" 'Filter all dates in September.
 Case 34: s = "xlFilterBelowAverage" 'Filter all below-average values.
 Case 8: s = "xlFilterLastMonth" 'Filter all values related to last month.
 Case 11: s = "xlFilterLastQuarter" 'Filter all values related to last quarter.
 Case 5: s = "xlFilterLastWeek" 'Filter all values related to last week.
 Case 14: s = "xlFilterLastYear" 'Filter all values related to last year.
 Case 9: s = "xlFilterNextMonth" 'Filter all values related to next month.
 Case 12: s = "xlFilterNextQuarter" 'Filter all values related to next quarter.
 Case 6: s = "xlFilterNextWeek" 'Filter all values related to next week.
 Case 15: s = "xlFilterNextYear" 'Filter all values related to next year.
 Case 7: s = "xlFilterThisMonth" 'Filter all values related to the current month.
 Case 10: s = "xlFilterThisQuarter" 'Filter all values related to the current quarter.
 Case 4: s = "xlFilterThisWeek" 'Filter all values related to the current week.
 Case 13: s = "xlFilterThisYear" 'Filter all values related to the current year.
 Case 1: s = "xlFilterToday" 'Filter all values related to the current date.
 Case 3: s = "xlFilterTomorrow" 'Filter all values related to tomorrow.
 Case 16: s = "xlFilterYearToDate" 'Filter all values from today until a year ago.
 Case 2: s = "xlFilterYesterday" 'Filter all values related to yesterday.
 End Select
End Sub