filter out multiple criteria using excel vba

Question

I have 8 variables in column A, 1,2,3,4,5 and A, B, C.
My aim is to filter out A, B, C and display only 1-5.

I can do this using the following code:

My_Range.AutoFilter Field:=1, Criteria1:=Array("1", "2", "3","4","5"), _
    Operator:=xlFilterValues

But what the code does is it filters variables 1 to 5 and displays them.

I want to do the opposite, but yielding the same result, by filtering out A, B, C and showing variables 1 to 5

I tried this code:

My_Range.AutoFilter Field:=1, Criteria1:=Array("<>A", "<>B", "<>C"), _
    Operator:=xlFilterValues

But it did not work.

Why cant I use this code ?

It gives this error:

Run time error 1004 autofilter method of range class failed

How can I perform this?

Samarium

possible duplicate of Excel VBA autofilter all but three – Astra

Answer 1

I think (from experimenting - MSDN is unhelpful here) that there is no direct way of doing this. Setting Criteria1 to an Array is equivalent to using the tick boxes in the dropdown - as you say it will only filter a list based on items that match one of those in the array.

Interestingly, if you have the literal values "<>A" and "<>B" in the list and filter on these the macro recorder comes up with

Range.AutoFilter Field:=1, Criteria1:="=<>A", Operator:=xlOr, Criteria2:="=<>B"

which works. But if you then have the literal value "<>C" as well and you filter for all three (using tick boxes) while recording a macro, the macro recorder replicates precisely your code which then fails with an error. I guess I'd call that a bug - there are filters you can do using the UI which you can't do with VBA.

Anyway, back to your problem. It is possible to filter values not equal to some criteria, but only up to two values which doesn't work for you:

Range("$A$1:$A$9").AutoFilter Field:=1, Criteria1:="<>A", Criteria2:="<>B", Operator:=xlAnd

There are a couple of workarounds possible depending on the exact problem:

1. Use a "helper column" with a formula in column B and then filter on that - e.g. =ISNUMBER(A2) or =NOT(A2="A", A2="B", A2="C") then filter on TRUE
2. If you can't add a column, use autofilter with Criteria1:=">-65535" (or a suitable number lower than any you expect) which will filter out non-numeric values - assuming this is what you want
3. Write a VBA sub to hide rows (not exactly the same as an autofilter but it may suffice depending on your needs).

For example:

Public Sub hideABCRows(rangeToFilter As Range)
  Dim oCurrentCell As Range
  On Error GoTo errHandler

  Application.ScreenUpdating = False
  For Each oCurrentCell In rangeToFilter.Cells
    If oCurrentCell.Value = "A" Or oCurrentCell.Value = "B" Or oCurrentCell.Value = "C" Then
      oCurrentCell.EntireRow.Hidden = True
    End If
  Next oCurrentCell

  Application.ScreenUpdating = True
  Exit Sub

errHandler:
    Application.ScreenUpdating = True
End Sub

Stirpiculture

Thank you very much. This is exactly what i was looking for, an informative and educational answer. Keep up the good work. – Samarium

Hey @aucuparia, I was unable to replicate the bug you mentioned. The recorded macro (no matter what as long as there were more than 2 values filtered and 2 values unfiltered) always recorded just the unfiltered values: Criteria1:= Array("<>D", "<>E", "<>F", "<>G"). Do you remember how you got the error? I'd be very interested to see. – Affer

Answer 2

I don't have found any solution on Internet, so I have implemented one.

The Autofilter code with criteria is then

iColNumber = 1
Dim aFilterValueArray() As Variant
Call ConstructFilterValueArray(aFilterValueArray, iColNumber, Array("A", "B", "C"))

ActiveSheet.range(sRange).AutoFilter Field:=iColNumber _
    , Criteria1:=aFilterValueArray _
    , Operator:=xlFilterValues

In fact, the ConstructFilterValueArray() method (not function) get all distinct values that it found in a specific column and remove all values present in last argument.

The VBA code of this method is

'************************************************************
'* ConstructFilterValueArray()
'************************************************************

Sub ConstructFilterValueArray(a() As Variant, iCol As Integer, aRemoveArray As Variant)

    Dim aValue As New Collection
    Call GetDistinctColumnValue(aValue, iCol)
    Call RemoveValueList(aValue, aRemoveArray)
    Call CollectionToArray(a, aValue)

End Sub

'************************************************************
'* GetDistinctColumnValue()
'************************************************************

Sub GetDistinctColumnValue(ByRef aValue As Collection, iCol As Integer)

    Dim sValue As String

    iEmptyValueCount = 0
    iLastRow = ActiveSheet.UsedRange.Rows.Count

    Dim oSheet: Set oSheet = Sheets("X")

    Sheets("Data")
        .range(Cells(1, iCol), Cells(iLastRow, iCol)) _
            .AdvancedFilter Action:=xlFilterCopy _
                          , CopyToRange:=oSheet.range("A1") _
                          , Unique:=True

    iRow = 2
    Do While True
        sValue = Trim(oSheet.Cells(iRow, 1))
        If sValue = "" Then
            If iEmptyValueCount > 0 Then
                Exit Do
            End If
            iEmptyValueCount = iEmptyValueCount + 1
        End If

        aValue.Add sValue
        iRow = iRow + 1
    Loop

End Sub

'************************************************************
'* RemoveValueList()
'************************************************************

Sub RemoveValueList(ByRef aValue As Collection, aRemoveArray As Variant)

    For i = LBound(aRemoveArray) To UBound(aRemoveArray)
        sValue = aRemoveArray(i)
        iMax = aValue.Count
        For j = iMax To 0 Step -1
            If aValue(j) = sValue Then
                aValue.Remove (j)
                Exit For
            End If
        Next j
     Next i

End Sub

'************************************************************
'* CollectionToArray()
'************************************************************

Sub CollectionToArray(a() As Variant, c As Collection)

    iSize = c.Count - 1
    ReDim a(iSize)

    For i = 0 To iSize
        a(i) = c.Item(i + 1)
    Next

End Sub

This code can certainly be improved in returning an Array of String but working with Array in VBA is not easy.

CAUTION: this code work only if you define a sheet named X because CopyToRange parameter used in AdvancedFilter() need an Excel Range !

It's a shame that Microfsoft doesn't have implemented this solution in adding simply a new enum as xlNotFilterValues ! ... or xlRegexMatch !

Stupor

Answer 3

Alternative using VBA's Filter function

As an innovative alternative to @schlebe 's recent answer, I tried to use the Filter function integrated in VBA, which allows to filter out a given search string setting the third argument to False. All "negative" search strings (e.g. A, B, C) are defined in an array. I read the criteria in column A to a datafield array and basicly execute a subsequent filtering (A - C) to filter these items out.

Code

Sub FilterOut()
Dim ws  As Worksheet
Dim rng As Range, i As Integer, n As Long, v As Variant
' 1) define strings to be filtered out in array
  Dim a()                    ' declare as array
  a = Array("A", "B", "C")   ' << filter out values
' 2) define your sheetname and range (e.g. criteria in column A)
  Set ws = ThisWorkbook.Worksheets("FilterOut")
  n = ws.Range("A" & ws.Rows.Count).End(xlUp).row
  Set rng = ws.Range("A2:A" & n)
' 3) hide complete range rows temporarily
  rng.EntireRow.Hidden = True
' 4) set range to a variant 2-dim datafield array
  v = rng
' 5) code array items by appending row numbers
  For i = 1 To UBound(v): v(i, 1) = v(i, 1) & "#" & i + 1: Next i
' 6) transform to 1-dim array and FILTER OUT the first search string, e.g. "A"
  v = Filter(Application.Transpose(Application.Index(v, 0, 1)), a(0), False, False)
' 7) filter out each subsequent search string, i.e. "B" and "C"
  For i = 1 To UBound(a): v = Filter(v, a(i), False, False): Next i
' 8) get coded row numbers via split function and unhide valid rows
  For i = LBound(v) To UBound(v)
      ws.Range("A" & Split(v(i) & "#", "#")(1)).EntireRow.Hidden = False
  Next i
End Sub

Examen

Answer 4

An option using AutoFilter

---

Option Explicit

Public Sub FilterOutMultiple()
    Dim ws As Worksheet, filterOut As Variant, toHide As Range

    Set ws = ActiveSheet
    If Application.WorksheetFunction.CountA(ws.Cells) = 0 Then Exit Sub 'Empty sheet

    filterOut = Split("A B C D E F G")

    Application.ScreenUpdating = False
    With ws.UsedRange.Columns("A")
        If ws.FilterMode Then .AutoFilter
       .AutoFilter Field:=1, Criteria1:=filterOut, Operator:=xlFilterValues
        With .SpecialCells(xlCellTypeVisible)
            If .CountLarge > 1 Then Set toHide = .Cells 'Remember unwanted (A, B, and C)
        End With
       .AutoFilter
        If Not toHide Is Nothing Then
            toHide.Rows.Hidden = True                   'Hide unwanted (A, B, and C)
           .Cells(1).Rows.Hidden = False                'Unhide header
        End If
    End With
    Application.ScreenUpdating = True
End Sub

Zig

Answer 5

Here an option using a list written on some range, populating an array that will be fiiltered. The information will be erased then the columns sorted.

Sub Filter_Out_Values()

'Automation to remove some codes from the list
Dim ws, ws1 As Worksheet
Dim myArray() As Variant
Dim x, lastrow As Long
Dim cell As Range

Set ws = Worksheets("List")
Set ws1 = Worksheets(8)
lastrow = ws.Cells(Application.Rows.Count, 1).End(xlUp).Row

'Go through the list of codes to exclude
For Each cell In ws.Range("A2:A" & lastrow)

    If cell.Offset(0, 2).Value = "X" Then 'If the Code is associated with "X"
        ReDim Preserve myArray(x) 'Initiate array
        myArray(x) = CStr(cell.Value) 'Populate the array with the code
        x = x + 1 'Increase array capacity
        ReDim Preserve myArray(x) 'Redim array
    End If

Next cell

lastrow = ws1.Cells(Application.Rows.Count, 1).End(xlUp).Row
ws1.Range("C2:C" & lastrow).AutoFilter field:=3, Criteria1:=myArray, Operator:=xlFilterValues
ws1.Range("A2:Z" & lastrow).SpecialCells(xlCellTypeVisible).ClearContents
ws1.Range("A2:Z" & lastrow).AutoFilter field:=3

'Sort columns
lastrow = ws1.Cells(Application.Rows.Count, 1).End(xlUp).Row
'Sort with 2 criteria
With ws1.Range("A1:Z" & lastrow)
    .Resize(lastrow).Sort _
    key1:=ws1.Columns("B"), order1:=xlAscending, DataOption1:=xlSortNormal, _
    key2:=ws1.Columns("D"), order1:=xlAscending, DataOption1:=xlSortNormal, _
    Header:=xlYes, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin
End With

End Sub

Karnak

Answer 6

This works for me: This is a criteria over two fields/columns (9 and 10), this filters rows with values >0 on column 9 and rows with values 4, 7, and 8 on column 10. lastrow is the number of rows on the data section.

ActiveSheet.Range("$A$1:$O$" & lastrow).AutoFilter Field:=9, Criteria1:=">0", Operator:=xlAnd
ActiveSheet.Range("$A$1:$O$" & lastrow).AutoFilter Field:=10, Criteria1:=Arr("4","7","8"), Operator:=xlFilterValues

Inculcate

Answer 7

Please check this one for filtering out values in a range; It works.

Selection.AutoFilter field:=33, Criteria1:="<>Array(IN1R,IN2R,INDA)", Operator:=xlFilterValues

Actually, the above code did not work. Hence I give a loop to hide the entire row whenever the active cell has the value that I am searching for.

For each cell in selection
    If cell.value = “IN1R” or cell.value = “INR2” or cell.value = “INDA” then
    Else
        Activecell.Entirerow.Hidden = True
    End if
Next

Lichenology

Answer 8

Okay, I solved it.

I've smashed my head about this problem several times over the years, but I've solved it.

All we need to do is look at all the values that are actually IN the filter range, and if they're not on the list of values we want to filter out, we add them to the "Filter For this item" list.

To note about this code:

• I wrote this to act on multiple sheets, and I'm not going to change that as I'm at work and don't have time. I'm sure you can figure it out.
• I don't think you need to work in Option base 1... But I am, so if you run into issues... might be that.
• Despite how many hundreds of thousands of times it's checking and rechecking the same arrays, it's remarkably fast.
• I'm sure there is a way to redim KeepArray, but I didn't have time to consider it.

Option Explicit
Option Base 1
Sub FilterTable()
    
    Dim WS As Worksheet
    Dim L As Long
    Dim I As Long
    Dim N As Long
    Dim tbl As ListObject
    Dim tblName As String
    Dim filterArray
    Dim SrcArray
    Dim KeepArray(1 To 5000) ' you might be able to figure out a way to redim this easiely later on.. for now I'm just oversizing it.

    N = 0
    filterArray = Array("FilterMeOut007", _
                        "FilterMeOut006", _
                        "FilterMeOut005", _
                        "FilterMeOut004", _
                        "FilterMeOut003", _
                        "FilterMeOut002", _
                        "FilterMeOut001")


    For Each WS In ThisWorkbook.Worksheets
        Debug.Print WS.Name
        If Left(WS.Name, 4) = "AR -" Then
            With WS
                tblName = Replace(WS.Name, " ", "_")
                Set tbl = WS.ListObjects(tblName)
                SrcArray = tbl.ListColumns(1).DataBodyRange
                For I = 1 To UBound(SrcArray, 1)
                    If Not ExistsInArray(KeepArray, SrcArray(I, 1)) _
                        And Not ExistsInArray(filterArray, SrcArray(I, 1)) Then
                            N = N + 1
                            KeepArray(N) = SrcArray(I, 1)
                    End If
                Next I
                tbl.DataBodyRange.AutoFilter Field:=1, Criteria1:=KeepArray, Operator:=xlFilterValues
            End With
        End If
    Next WS
End Sub
Function ExistsInArray(arr, Val) As Boolean
    Dim I As Long
    ExistsInArray = False
    For I = LBound(arr) To UBound(arr)
        If arr(I) = Val Then
            ExistsInArray = True
            Exit Function
        End If
    Next I
End Function

Please let me know if you run into any errors with this as I'd like to stress test and debug it as much as possible in the future to make it as portable as possible. I picture using it a lot.

Affer