INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Jobs

VBA Visual Basic for Applications (Microsoft) FAQ

Office / VBA General

Loop Through Filters Adding Criteria to A String by idbr
Posted: 27 Apr 06

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! dazed

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 .Operator 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).Operator = xlOr Or rngFilter.Worksheet.AutoFilter.Filters(i).Operator = 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

Back to VBA Visual Basic for Applications (Microsoft) FAQ Index
Back to VBA Visual Basic for Applications (Microsoft) Forum

My Archive

Resources

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close