Exclude from filter

[Rudi]

Hi,

Here is another tricky one I am assisting with in Excel Forum. (Thread here!)
When you click the Filter button and tick a chkbox, that value should be EXCLUDED from the filter in the B column.
I am getting a bit jello-minded with the syntax.
Pls help if anyone can. TX

Book2 v2.2.xlsm

[HansV]

Can you try to explain more clearly what you want? I can't make heads or tails of it, sorry.

[Rudi]

Can you try to explain more clearly what you want? I can't make heads or tails of it, sorry.

Sorry... The person I'm assisting asked for a reversed filter...
It was all working very well before I had to reverse it. Initially when I canged the filter action, and ticked R1, it would remove R1 from the list and preserve all the unticked records which was good, BUT, the other values that were not represented with a check box were also filtered out, like (checkbox 1 and checkbox 5) in the sample file. They should ALWAYS remain.

So in summary:
Check R1 - all records remain except R1
Check R1 and F4 - all records remain except R1 and F4
Before I stuffed it up, when I ticked R1, R1 would hide, but the checkbox 1 and 5 also hid because they were not represented on the dialog.

Hope that's a bit clearer. TX
BTW: Ignore the check boxes on the worksheet!

1.jpg

[HansV]

Set a reference to Microsoft Scripting Runtime, and change the code as follows:

Code: Select all

Private Sub cmdFilter_Click()
    Dim cChk As Control, arrVals, i As Long
    Dim X, objDict As Scripting.Dictionary, lngRow As Long

    Application.ScreenUpdating = False

    'Clear filters
    On Error Resume Next
    ActiveSheet.ShowAllData
    On Error GoTo 0

    'Get unique list of values in the filter column (Col. "B")
    Set objDict = New Scripting.Dictionary
    X = Application.Transpose(Range("B13", Cells(Rows.Count, "B").End(xlUp)))
    For lngRow = 1 To UBound(X, 1)
        objDict(X(lngRow)) = 1
    Next lngRow

    For Each cChk In Me.Controls
        If TypeName(cChk) = "CheckBox" Then
            If cChk.Value = True Then
                objDict.Remove cChk.Tag
            End If
        End If
    Next cChk

    ReDim arrVals(objDict.Count - 1)
    For i = 0 To objDict.Count - 1
        arrVals(i) = objDict.Keys(i)
    Next i

    On Error Resume Next
    ActiveSheet.Range("A12").CurrentRegion.AutoFilter _
        Field:=2, _
        Criteria1:=arrVals, _
        Operator:=xlFilterValues
    Unload Me
    Application.ScreenUpdating = False
End Sub