Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations bkrike on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Loop Through Filters Adding Criteria to A String

Office / VBA General

Loop Through Filters Adding Criteria to A String

by  idbr  Posted    (Edited  )
I've had a bit of a nightmare trying to get this to work, so thought I'd post it here in case I can save anyone a bit of frustration! %-)

You can use the following code to loop through the current set of filters on a worksheet adding the criteria values to a string. Note that it only works for single and and/or selections. To use it for other filter types, change the [color blue].Operator[/color blue] argument to suit.

Code: 
Public Function Get_Filter_Criteria() As String

Dim rngFilter As Range

Dim strCriteria As String
Dim strFilter1 As String
Dim strFilter2 As String

Dim i As Integer

strCriteria = ""

Set rngFilter = ActiveCell.CurrentRegion

i = 1

'Are filters active?
If ActiveSheet.AutoFilterMode = True Then

    'Loop through the filters, appending the criteria
    Do Until i = rngFilter.Worksheet.AutoFilter.Filters.Count + 1
        
        'Is the filter on?
        If rngFilter.Worksheet.AutoFilter.Filters(i).On = True Then
             'Is there more than one criteria item for this filter?
             If (rngFilter.Worksheet.AutoFilter.Filters(i)[color blue].Operator[/color blue] = xlOr Or rngFilter.Worksheet.AutoFilter.Filters(i)[color blue].Operator[/color blue] = xlAnd) Then
     
                 'If so, add both criteria items to the output string
                 strFilter1 = Right(rngFilter.Worksheet.AutoFilter.Filters(i).Criteria1, Len(rngFilter.Worksheet.AutoFilter.Filters(i).Criteria1) - 1)
                 strFilter2 = Right(rngFilter.Worksheet.AutoFilter.Filters(i).Criteria2, Len(rngFilter.Worksheet.AutoFilter.Filters(i).Criteria2) - 1)
                 
                 'Row 8 is the header row for this sheet, amend as necessary
                 strCriteria = strCriteria & Cells(8, i).Value & " = " & strFilter1 & "/" & strFilter2 & " : "
         
                 Debug.Print "strCriteria = " & strCriteria
                 
             Else
     
                 'Just add Criteria1
                 strFilter1 = Right(rngFilter.Worksheet.AutoFilter.Filters(i).Criteria1, Len(rngFilter.Worksheet.AutoFilter.Filters(i).Criteria1) - 1)
                 
                 'Row 8 is the header row for this sheet, amend as necessary
                 strCriteria = strCriteria & Cells(8, i).Value & " = " & strFilter1 & " : "
                 
                 Debug.Print "strCriteria = " & strCriteria

             End If
         
        Else
            
        End If
        
        i = i + 1
    
    Loop
    
End If

'Trim the output string to remove the extra colon

If Len(strCriteria) > 0 Then

    Get_Filter_Criteria = Left(Trim(strCriteria), Len(Trim(strCriteria)) - 2)

Else

End If

End Function

I'm calling it from the Worksheet_Calculate event and adding the result to a cell:

Code: 
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)

If ActiveSheet.Name <> "MySheetName" Then Exit Sub

Range("MyCellRef").Value = Get_Filter_Criteria()

End Sub

Hope this helps someone, Iain
Register to add this FAQ to your archive
Register to rate this FAQ  : BAD 1 2 3 4 5 6 7 8 9 10 GOOD
Please Note: 1 is Bad, 10 is Good :-)

Part and Inventory Search

Back
Top