Loop through filter criteria - excel

Question

I've been trying to figure this out but no progress...
I have a filter (COLUMN D) and I'm trying to create a loop to each criteria (I got at least 1000 criterias) on my filter.
Ex: For each criteria on filter (column D), I'll run a range copy...
That code isnt working at all:
Sub WhatFilters()
Dim iFilt As Integer
iFilt = 4
Dim iFiltCrit As Integer
Dim numFilters As Integer
Dim crit1 As Variant
ActiveSheet.Range("$A$1:$AA$4635").AutoFilter Field:=16, Criteria1:= _
"Waiting"
numFilters = ActiveSheet.AutoFilter.Filters.Count
Debug.Print "Sheet(" & ActiveSheet.Name & ") has " & numFilters & " filters."
If ActiveSheet.AutoFilter.Filters.Item(iFilt).On Then
crit1 = ActiveSheet.AutoFilter.Filters.Item(iFilt).Criteria1
For iFiltCrit = 1 To UBound(crit1)
Debug.Print "crit1(" & iFiltCrit & ") is '" & crit1(iFiltCrit)
'Copy everything
Next iFiltCrit
End If
End Sub
My mistake seems to be identifying my filter column...

Answer 1

I realize this was asked a while ago but I havent seen anything that I consider copy-paste ready. here is what I came up with. It should work for unlimited criteria. It does create a single new sheet called "temp" that can be deleted once finished.
Dim currentCell As Long
Dim numOfValues As Long
Sub filterNextResult()
' copy and move the data from the data sheet, column A (can be changed if needed) to a new sheet called "temp"
' check to make sure there is at least 1 data point in column A on the temp sheet
If currentCell = 0 Then
Application.ScreenUpdating = False
Call createNewTemp
Application.ScreenUpdating = True
End If
' find the total number of unique data points we will be filtering by in column A of the temp sheet
If numOfAccounts = 0 Then
Application.ScreenUpdating = False
Call findNumOfValues
Application.ScreenUpdating = True
End If
With Sheet1.UsedRange
.AutoFilter 1, Worksheets("temp").Range("A" & currentCell).Value
currentCell = currentCell + 1
' check to make sure we havent reached the end of clumn A. if so exit the sub
If numOfValues + 1 = currentCell Then
MsgBox ("This was the last value to filter by")
Exit Sub
End If
End With
End Sub
'sub that will look for the number of values on the temp sheet column a
Private Sub findNumOfValues()
' count the number of non empty cells and assign that value (less 1 for the title in our case) to the numOfValues
numOfValues = Worksheets("temp").Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count
End Sub
Private Sub createNewTemp()
Sheet1.Range("A:A").Copy
ActiveWorkbook.Sheets.Add.Name = "temp"
' remove duplicates
Worksheets("temp").Range("A1").Select
With ActiveWorkbook.ActiveSheet
.Paste
.Range("A:A").RemoveDuplicates Columns:=Array(1), Header:=xlYes
End With
' check to make sure there are vlaues in the temp sheet
If Worksheets("temp").Range("A2").Value = "" Then
MsgBox "There are no filter values"
End
Else
currentCell = 2
End If
Sheet1.Activate
Sheet1.Range("A1").Select
Selection.AutoFilter
End Sub

Answer 2

This worked for me
Sub WhatFilters()
Dim iFilt As Integer
Dim i, j As Integer
Dim numFilters As Integer
Dim crit1 As Variant
If Not ActiveSheet.AutoFilterMode Then
Debug.Print "Please enable AutoFilter for the active worksheet"
Exit Sub
End If
numFilters = ActiveSheet.AutoFilter.Filters.Count
Debug.Print "Sheet(" & ActiveSheet.Name & ") has " & numFilters & " filters."
For i = 1 To numFilters
If ActiveSheet.AutoFilter.Filters.Item(i).On Then
crit1 = ActiveSheet.AutoFilter.Filters.Item(i).Criteria1
If IsArray(crit1) Then
'--- multiple criteria are selected in this column
For j = 1 To UBound(crit1)
Debug.Print "crit1(" & i & ") is '" & crit1(j) & "'"
Next j
Else
'--- only a single criteria is selected in this column
Debug.Print "crit1(" & i & ") is '" & crit1 & "'"
End If
End If
Next i
End Sub