Tom Ogilvy's Filter Check Function Adaptation Needed...

[madforplaid]

Tom or others,

I am trying to adapt Tom's auto filter check to always display in a
message box which filters are currently checked. From here, I'll use
an inStr check to perform other tasks.

Based upon my four criteria, I can't get all four to display in the
string variable (only two at a time). The Excel auto filter I am
using is as shown in this image: http://members.dslextreme.com/users/madforplaid/filterStatus.jpg

The function code of yours I have adapted is as follows:

--------------------------------------------

Public Function ShowFilter(rng As Range)
Dim filt As Filter
Dim sCrit1 As String
Dim sCrit2 As String
Dim sCrit3 As String
Dim sCrit4 As String
Dim sop As String
Dim lngOp As Long
Dim lngOff As Long
Dim frng As Range
Dim sh As Worksheet
Set sh = rng.Parent
If sh.FilterMode = False Then
ShowFilter = "No Active Filter"
Exit Function
End If
Set frng = sh.AutoFilter.Range

If Intersect(rng.EntireColumn, frng) Is Nothing Then
ShowFilter = CVErr(xlErrRef)
Else
lngOff = rng.Column - frng.Columns(1).Column + 1
If Not sh.AutoFilter.Filters(lngOff).On Then
ShowFilter = "No Conditions"
Else
Set filt = sh.AutoFilter.Filters(lngOff)
On Error Resume Next
sCrit1 = filt.Criteria1
sCrit2 = filt.Criteria2
sCrit3 = filt.Criteria3
sCrit4 = filt.Criteria4
lngOp = filt.Operator
If lngOp = xlAnd Then
sop = " And "
ElseIf lngOp = xlOr Then
sop = " or "
Else
sop = ""
End If
ShowFilter = sCrit1 & sop & sCrit2 & sop & sCrit3 & sop & sCrit4
End If
End If

MsgBox "ShowFilter = " & ShowFilter
End Function

 

[Dave Peterson]

If you're calling this from a formula in a worksheet, then using a msgbox will
get very irritating very fast. It'll show up each time that excel recalculates.

But...

Option Explicit
Public Function ShowFilter(rng As Range)
Dim myCell As Range
Dim filt As Filter
Dim sCrit1 As String
Dim sCrit2 As String
Dim sCrit3 As String
Dim sCrit4 As String
Dim sop As String
Dim lngOp As Long
Dim lngOff As Long
Dim frng As Range
Dim sh As Worksheet

Set sh = rng.Parent
If sh.FilterMode = False Then
ShowFilter = "No Active Filter"
Exit Function
End If
Set frng = sh.AutoFilter.Range


For Each myCell In rng.Cells
If Intersect(myCell.EntireColumn, frng) Is Nothing Then
ShowFilter = CVErr(xlErrRef)
Else
lngOff = myCell.Column - frng.Columns(1).Column + 1
If Not sh.AutoFilter.Filters(lngOff).On Then
ShowFilter = "No Conditions"
Else
sCrit1 = ""
sCrit2 = ""
sCrit3 = ""
sCrit4 = ""
Set filt = sh.AutoFilter.Filters(lngOff)
On Error Resume Next
sCrit1 = filt.Criteria1
sCrit2 = filt.Criteria2
sCrit3 = filt.Criteria3
sCrit4 = filt.Criteria4
lngOp = filt.Operator
If lngOp = xlAnd Then
sop = " And "
ElseIf lngOp = xlOr Then
sop = " or "
Else
sop = ""
End If
ShowFilter = ShowFilter & vbLf & sCrit1 _
& sop & sCrit2 & sop & sCrit3 & sop & sCrit4
End If
End If
Next myCell

MsgBox "ShowFilter = " & ShowFilter
End Function