Excluding items out of Filter in Macro

[Laura Ford]

I'm looked, but cannot find solution for the below.

I'm using a macro to filter out select suppliers. I'm fine as long as it is one or two. I need to now exclude all but 3.

This works for 2
ActiveSheet.Range(Selection, Selection.End(xlDown)).AutoFilter Field:=1, Criteria1:="<>66", Operator:=xlAnd, Criteria2:="<>79"
Tried this for 3 or more and it does not work.
ActiveSheet.Range(Selection, Selection.End(xlDown)).AutoFilter Field:=1, Criteria1:="<>66", Operator:=xlAnd, Criteria2:="<>79", Operator:=xlAnd, Criteria3:="<>382"

Thank you,

Laura

 

[Jerry Sullivan]

Hi Laura,

A column filter only allows up to two criteria.

There is an Operator:=xlFilterValues that allows you to filter to show an array of items. This is the operator that is used when you manually select the checkboxes for items to be shown.

This link has an example from Marcelo Branco and Peter_SSs
http://www.mrexcel.com/forum/excel-...er-multiple-criteria-not-working-numbers.html

As far as I know, there isn't an operator that does the opposite of that (filters to show all items except those in an array).
You could however build an array of all items, then remove the items not to be shown.

Here's an example....

Sub AutoFilterItemsExcept()
'---adds an autofilter at the selected cell(s), then filters the items below
'      to show all items in Field 1 except those in the Exception Array vExcept


'--Requires addding a Reference to Microsoft Scripting Runtime to VBAProject
'   in the VB Editor menubar > Tools > References... > Click the checkbox for "Microsoft Scripting Runtime"

    
    Dim vAll As Variant, vExcept As Variant
    Dim i As Long
    Dim dict As Scripting.Dictionary


    vExcept = Split("66,79,382", ",")  'or read list from range

    
    '--Create dictionary Object
    Set dict = CreateObject("Scripting.dictionary")


    With ActiveSheet.Range(Selection, Selection.End(xlDown))
        If .CountLarge > 10000 Then
            MsgBox "Range(Selection, Selection.End(xlDown)) has too many items"
            Exit Sub
        End If

        
        '--clear any existing filter
        .Parent.AutoFilterMode = False

        
        '--get list of all items in Field 1, convert numbers to strings
        vAll = Split(Join(Application.Transpose(.Resize(, 1).Cells)))

        
        '--populate dictionary with unique values, skip item 0 which is autofilter header
        For i = LBound(vAll) + 1 To UBound(vAll)
            If Not dict.Exists(vAll(i)) Then
                dict.Add vAll(i), i
            End If
        Next i

                
        '--remove items to be deselected in filter
        For i = LBound(vExcept) To UBound(vExcept)
            If dict.Exists(vExcept(i)) Then
                dict.Remove vExcept(i)
            End If
        Next i


        '--transfer to FilterValues array
        ReDim vAll(0 To dict.Count - 1)

        
        For i = 0 To dict.Count - 1
            vAll(i) = dict.Keys(i)
        Next i

  
        '--apply filter
        .AutoFilter Field:=1, Criteria1:=Split(Join(vAll)), Operator:=xlFilterValues
    End With
End Sub

 

[Laura Ford]

Thanks for the reply. I will have to look into this on Monday!

 

[Garry2Rs]

You could optimize that code some as follows...

Sub FilterExcludes()
  Const sExcludes$ = "1,2,3,4,5,6"
  Dim vAll, n&, dict
  
  With ActiveSheet.Range(Selection, Selection.End(xlDown))
    If .CountLarge > 10000 Then
      MsgBox "Range(Selection, Selection.End(xlDown)) has too many items"
      Exit Sub
    End If
    'Clear any existing filter
    .Parent.AutoFilterMode = False

    vAll = Split(Join(Application.Transpose(.Resize(, 1).Cells)))
    For n = 1 To UBound(vAll)
      If InStr(1, sExcludes, vAll(n)) > 0 Then vAll(n) = "~"
    Next 'n
    vAll = Filter(vAll, "~", False) '//resize the array
    
    'Remove duplicate items
    Set dict = CreateObject("Scripting.dictionary")
    For n = 1 To UBound(vAll)
      If Not dict.Exists(vAll(n)) Then
        dict.Add vAll(n), n
      Else
        vAll(n) = "~"
      End If 'Not dict.Exists
    Next 'n
    vAll = Filter(vAll, "~", False) '//resize the array
    
    'Apply filter
    .AutoFilter Field:=1, Criteria1:=Split(Join(vAll)), Operator:=xlFilterValues
  End With
  Set dict = Nothing
End Sub

..where data list is 1 to 26 and repeats 1 to 26 to add duplicates through rows 2 to 53, row1 has heading.

 

[Jerry Sullivan]

Hi Gary,

That's a nice approach, especially your use the dictionary to remove duplicates from the array without actually having to transfer the items back from the dictionary to the array.

I think the relative speed advantages of the two approaches would vary depending the ratios between the total number of items, the number of unique items and the number of items to be excluded.

Comparing the two with a data list of ~9000 items (1 to 26) repeated to make that list, both approaches completed the task in less than 0.1 sec.

I expected that your code would do much better when the ratio of excluded items was high such as: Const sExcludes$ = "1,2,3,..24,25" (leaving only the 26's),
since my approach has the extra step of removing each excluded item from the dictionary.

In testing the opposite is true (my approach works faster with a high ratio of excluded items), which leads me to believe that at a certain point there is less cost to removing the item from the dictionary than having to execute the Then statement when InStr repeatedly finds matches for the same excluded item.

If InStr(1, sExcludes, vAll(n)) > 0 Then vAll(n) = "~"

Given the very fast execution of both approaches, I think speed is less of a factor than simplicity and clarity and on that basis I like your code better.

Thanks for sharing that.

 

[Jerry Sullivan]

My apologies for mispelling your name Garry.

Based on your screenname which I didn't catch earlier, that must happen a lot.

 

[Garry2Rs]

Thanks for the feedback!

It was bothering me that the line that applies AutoFilter creates a new array out of an existing array. Not sure why the extra processing is needed because the following line works fine.

    .AutoFilter Field:=1, Criteria1:=vAll, Operator:=xlFilterValues

This prompted me to look at the line to load the array. The extra processing is not needed there either because the following line works fine.

    vAll = Application.Transpose(.Resize(, 1).Cells)

This also returns a 1D array but LBound is 1 instead of zero. In this case it doesn't matter about the header but the loops can be setup as follows.

    For n = LBound(vAll) + 1 To UBound(vAll)

 

[Jerry Sullivan]

Good point.

The basis for the use of...

.AutoFilter Field:=1, Criteria1:=Split(Join(vAll)), Operator:=xlFilterValues

instead of ...

.AutoFilter Field:=1, Criteria1:=vAll, Operator:=xlFilterValues

....was the lesson from the thread I referenced in Post #2. That numbers need to be cast as Strings to be used as an Autofilter list.

In retrospect, I've overburdened the code by doing that twice.
I believe it's necessary to do that once though...would you agree?

 

[Garry2Rs]

No, I don't agree. My list is numbers 1 to 26 (with 1 repeat). The only difference is whether you want a zero based array or a 1 based array!

 

[Garry2Rs]

I played around in XL2003 to duplicate this process there and here's what I came up with...

Sub FilterExcludes2()
  Const sExcludes$ = "1,2,3,4,5,6"
  Dim vAll, n&
  
  Application.ScreenUpdating = False
  With ActiveSheet.Range(Selection, Selection.End(xlDown))
    If WorksheetFunction.CountA(.Cells) > 10000 Then
      MsgBox "Range(" & .Address & ") has too many items"
      Exit Sub
    End If
    vAll = Application.Transpose(.Resize(, 1).Cells)
    For n = LBound(vAll) + 1 To UBound(vAll)
      If InStr(1, sExcludes, vAll(n)) > 0 Then Rows(n).Hidden = Not Rows(n).Hidden
    Next 'n
  End With
  Application.ScreenUpdating = True
End Sub

..which toggles the hidden rows. Not sure how efficient it would be with large amounts of items but I doubt this isn't any more an issue when excluding than it is including!

Also, note the revision to MsgBox that notifies too many items!