PDA

View Full Version : Listing All Criteria with Autofilter



maxell
03-23-2006, 07:44 AM
I have a large database which I filter for a range of conditions. The conditions are list boxes, which need to contain the same options as each criteria for each filtered column.

What VBA code can I use to get the available criteria for a particular filtered column? I am hoping to avoid having to use a procedure to loop through the column and select all unique entries.

Any suggestions?

Mike

HaHoBe
03-23-2006, 02:35 PM
Hi, Mike,

the following code may help:

Sub ShowAutoFilterCriteria()
' John Green et. al: Excel 2000 VBA Programmer?s Reference, S. 379f
' 09.01.2005
Dim oAF As AutoFilter
Dim oFlt As Filter
Dim sField As String
Dim sCrit1 As String
Dim sCrit2 As String
Dim sMsg As String
Dim i As Integer

' Check if the sheet is filtered at all
If ActiveSheet.AutoFilterMode = False Then
MsgBox "The sheet does not have an Autofilter"
Exit Sub
End If

' Get the sheet?s Autofilter object
Set oAF = ActiveSheet.AutoFilter

' Loop through the Filters of the Autofilter
For i = 1 To oAF.Filters.Count

' Get the field name form the first row
' of the Autofilter range
sField = oAF.Range.Cells(1, i).Value

' Get the Filter object
Set oFlt = oAF.Filters(i)

' If it is on...
If oFlt.On Then

' Get the standard filter criteria
sMsg = sMsg & vbCrLf & sField & oFlt.Criteria1

' If it?s a special filter, show it
Select Case oFlt.Operator
Case xlAnd
sMsg = sMsg & " And " & sField & oFlt.Criteria2
Case xlOr
sMsg = sMsg & " Or " & sField & oFlt.Criteria2
Case xlBottom10Items
sMsg = sMsg & " (bottom 10 items)"
Case xlBottom10Percent
sMsg = sMsg & " (bottom 10%)"
Case xlTop10Items
sMsg = sMsg & " (top 10 items)"
Case xlTop10Percent
sMsg = sMsg & " (top 10%)"
End Select
End If
Next i

If msg = "" Then
' No filters are applied, so say so
sMsg = "The range " & oAF.Range.Address & " is not filtered."
Else
' Filters are applied, so show them
sMsg = "The range " & oAF.Range.Address & " is filtered by:" & sMsg
End If

' Display the message
MsgBox sMsg
End Sub
Or you apply this function indicating the first filtered row in the list:
Public Function AF_CRIT(rngRange As Range) As String

Dim s_Filter As String

s_Filter = ""
On Error GoTo EndFunc
With rngRange.Parent.AutoFilter
With .Filters(rngRange.Column - .Range.Column + 1)
s_Filter = .Criteria1
Select Case .Operator
Case xlAnd
s_Filter = s_Filter & " AND " & .Criteria2
Case xlOr
s_Filter = s_Filter & " OR " & .Criteria2
End Select
End With
End With
EndFunc:
AF_CRIT = s_Filter
End Function
HTH
Holger

maxell
03-24-2006, 05:31 PM
Thanks for this reply - I'll try it. I think I understand that this relies on a criteria already being selected? Will let you know how it goes.

Mike