VBA - using code to filter criteria NOT to include in a filter...

[Panthers0027]

Hello,

I use Office 2007.

I have a table, that I'd like to filter in my code. I'm trying to filter out certain names. Using the Macro Recorder I get this:

 ActiveSheet.ListObjects("Table5").Range.AutoFilter Field:=3, Criteria1:= _
        Array("Name1", "Name2", "Name3"), Operator:=xlFilterValues

The table has many more names, I just shortened it for this question. I'd like to know how I can simply filter out certain names. i.e. I want to take out "Sponsor" & "Sponsor Dept" as the names.

How can I do this?

Thanks for any help that you can provide!
Andre

 

[Builder Steve]

It is really quite simple. Use a code like Criteria1:="<>*Hide*"
This code will include everything in the filter but exclude the word "Hide"
<> mean not equal in excel
* tells the program to look for text

So your code should look something like this if you wanted to exclude items titled hide.
ActiveSheet.Range("Your Range he").AutoFilter Field:=17, Criteria1:="<>*Hide*", Operator:= xlFilterValues

Here is a useful tutorial on using some features of autofilters Criteria for VBA AutoFilters. How to use AutoFilter Criteria in Excel VBA

 

[treva31]

You can also run multiple filters one after the other.
So you could loop through your unwanted keywords removing them one at a time:

keyword1="Sponsor"
ActiveSheet.ListObjects("Table5").Range.AutoFilter Field:=3, Criteria1:="<>" & keyword1, Operator:=xlFilterValues
keyword1="Advertiser"
ActiveSheet.ListObjects("Table5").Range.AutoFilter Field:=3, Criteria1:="<>" & keyword1, Operator:=xlFilterValues
keyword1="Radio"
ActiveSheet.ListObjects("Table5").Range.AutoFilter Field:=3, Criteria1:="<>" & keyword1, Operator:=xlFilterValues

 

[Snobid]

You can also run multiple filters one after the other.
So you could loop through your unwanted keywords removing them one at a time:

keyword1="Sponsor"
ActiveSheet.ListObjects("Table5").Range.AutoFilter Field:=3, Criteria1:="<>" & keyword1, Operator:=xlFilterValues
keyword1="Advertiser"
ActiveSheet.ListObjects("Table5").Range.AutoFilter Field:=3, Criteria1:="<>" & keyword1, Operator:=xlFilterValues
keyword1="Radio"
ActiveSheet.ListObjects("Table5").Range.AutoFilter Field:=3, Criteria1:="<>" & keyword1, Operator:=xlFilterValues

The filters do not seem to stack. Trying out this code, only the last cirteria was applied. Wondering if anyone has managed to find a solution to this problem

 

[VikP]

I ran into this problem recently. The .autofilter only has 2 criteria you can use and using an array for the criteria doesn’t allow you to use the “<>Name1” format. So we are stuck for a quick way to deselect multiple items with the autofilter. I was able to find a work around.

In my case, I need to generate a daily transaction activity report for financial accounts. I start with unformatted data and use VBA to format it. Column C lists the activity types for each of the transactions. I am not interested in a few of the types and I wanted to be able to deselect them in the autofilter using vba. There are a large number of possible types that can be used and occasionally types show up that I haven’t encountered before. Because of this, writing code to select all of the possible types was not an option, especially since I would have to check the results every day to make sure new codes weren’t missed.

I was able to get around this problem by storing all the activity types I didn’t want to see in an array. Then I looped through all of the activity types in the report and compared them to my array; if they weren’t in the array I added them to a second array. I then used the second array as the criteria in the autofilter.

    'apply a filter, row 1 contains my titles
    Range("A1:L1").Select
    Selection.AutoFilter
 
    Dim filterCriteria() As String
    Dim count As Long, secondArray As Variant
    Dim L As Long, c As String, k As String, rowNumb As Long
   
    secArray = Array("Type1", " Type2", " Type3", " Type4")
   
    c = 0
    k = 0
    count = 0
    rowNumb = ActiveSheet.Range(ActiveSheet.Range("C2"), ActiveSheet.Range("C1").End(xlDown)).Rows.count
   
    For L = 1 To rowNumb
        c = ActiveSheet.Range("C1").Offset(L)
        If c <> k Then
            'check the current activity type against the array of types we don’t want. If it isn’t in the array we add it to an array that will be used as the filter criteria
            If UBound(Filter(secondArray, c)) = -1 Then
                ReDim Preserve filterCriteria(0 To count)
                filterCriteria(count) = c
                count = count + 1
            End If
 
            k = c
        End If
    Next
   
    With ActiveSheet
        .Range(.Range("A1"), .Range("A1").End(xlDown).Offset(0, 11)).AutoFilter Field:=3, Criteria1:=filterCriteria, Operator:=xlFilterValues
    End With

It would be faster without the loop but for what I need it works.

 

[dbnemetz]

Hello,

I use Office 2007.

I have a table, that I'd like to filter in my code. I'm trying to filter out certain names. Using the Macro Recorder I get this:

 ActiveSheet.ListObjects("Table5").Range.AutoFilter Field:=3, Criteria1:= _
        Array("Name1", "Name2", "Name3"), Operator:=xlFilterValues

The table has many more names, I just shortened it for this question. I'd like to know how I can simply filter out certain names. i.e. I want to take out "Sponsor" & "Sponsor Dept" as the names.

How can I do this?

Thanks for any help that you can provide!
Andre

I came about your thread because I had the same problem. I solved the vba problem with a non-vba mechanism.

Most of my worksheets are populated by flatfile exports generated by PLSQL queries. Because I have that strong tool at my disposal, I often find the simplest solution is to modify my Select statement.

In this case I have 3 items to exclude, I change the name of the latter 2 to match the first.

select 
   decode(upper(COLUMN_NAME),'LITERAL_1','LITERAL_0','LITERAL_2','LITERAL_0',upper(COLUMN_NAME)) as COLUMN_NAME
from TABLE_NAME

This way, all items named 'LITERAL_0','LITERAL_1','LITERAL_2' are now named LITERAL_0, so only one exclusion has to apply within the VBA.

Good luck.

 

[Mhaddy]

For anyone using the code below (THANK YOU SO MUCH) - be sure to change the line "secArray = Array("Type1", " Type2", " Type3", " Type4")" to "secondArray = Array("Type1", " Type2", " Type3", " Type4")" - I spent so much time debugging this . So helpful!

I ran into this problem recently. The .autofilter only has 2 criteria you can use and using an array for the criteria doesn’t allow you to use the “<>Name1” format. So we are stuck for a quick way to deselect multiple items with the autofilter. I was able to find a work around.

In my case, I need to generate a daily transaction activity report for financial accounts. I start with unformatted data and use VBA to format it. Column C lists the activity types for each of the transactions. I am not interested in a few of the types and I wanted to be able to deselect them in the autofilter using vba. There are a large number of possible types that can be used and occasionally types show up that I haven’t encountered before. Because of this, writing code to select all of the possible types was not an option, especially since I would have to check the results every day to make sure new codes weren’t missed.

I was able to get around this problem by storing all the activity types I didn’t want to see in an array. Then I looped through all of the activity types in the report and compared them to my array; if they weren’t in the array I added them to a second array. I then used the second array as the criteria in the autofilter.

    'apply a filter, row 1 contains my titles
    Range("A1:L1").Select
    Selection.AutoFilter
 
    Dim filterCriteria() As String
    Dim count As Long, secondArray As Variant
    Dim L As Long, c As String, k As String, rowNumb As Long
   
    secondArray = Array("Type1", " Type2", " Type3", " Type4")
   
    c = 0
    k = 0
    count = 0
    rowNumb = ActiveSheet.Range(ActiveSheet.Range("C2"), ActiveSheet.Range("C1").End(xlDown)).Rows.count
   
    For L = 1 To rowNumb
        c = ActiveSheet.Range("C1").Offset(L)
        If c <> k Then
            'check the current activity type against the array of types we don’t want. If it isn’t in the array we add it to an array that will be used as the filter criteria
            If UBound(Filter(secondArray, c)) = -1 Then
                ReDim Preserve filterCriteria(0 To count)
                filterCriteria(count) = c
                count = count + 1
            End If
 
            k = c
        End If
    Next
   
    With ActiveSheet
        .Range(.Range("A1"), .Range("A1").End(xlDown).Offset(0, 11)).AutoFilter Field:=3, Criteria1:=filterCriteria, Operator:=xlFilterValues
    End With

It would be faster without the loop but for what I need it works.

 

[mmurrietta]

Hi,

I ran into a similar problem where I needed to filter all values that are NOT in a specific array of non-numeric values. It is easily ascertained from recording a macro how to filter a range using an array of values and with this I shifted the problem to dynamically acquiring the array of values to filter. In this case you need two arrays, one larger than the other and the larger one must contain all of the values in the smaller one; the smaller array is a proper subset of the larger array. I didn't create the "IsInArray" function, I got that from here.

Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
    IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function
Function ComplimentaryArray(arr, subArr)
'returns false if subArr is not a proper subset of arr
'returns the complimentary array if it is
'first checks if the values of subArr are a proper subset of arr
'second produces the compliment of subArr, that is, the remaining
'values of arr that are not in subArr.
    If (UBound(arr) - LBound(arr) + 1) = (UBound(subArr) - LBound(subArr) + 1) Then
        ComplimentaryArray = False  'exits and returns false
    Else
        For i = LBound(subArr) To UBound(subArr)
            If IsInArray(CStr(subArr(i)), arr) = False Then
                ComplimentaryArray = False  'exits and returns false
            End If
        Next i
        'if the code proceeds to this point then subArr is truly a subset of arr
        ReDim tempArr(1 To (UBound(arr) - LBound(arr) + 1) - (UBound(subArr) - LBound(subArr) + 1))
        j = 1
        For i = LBound(arr) To UBound(arr)
            If IsInArray(CStr(arr(i)), subArr) = False Then
                tempArr(j) = arr(i)
                j = j + 1
            End If
        Next i
        ComplimentaryArray = tempArr  'exits and returns the complimentary array
    End If
End Function

Here's an example script where I used it:

Sub DataPrep()
    Dim dat As Worksheet, t0 As Single, sch As Worksheet
    Application.ScreenUpdating = False
    t0 = Timer
    Set dat = Sheets("Data")
    Set sch = Sheets("Schedule")
    datLR = dat.[a1].End(xlDown).Row
    schLR = sch.[a1].End(xlDown).Row
    col = Split(dat.[a1].End(xlToRight).Address, "$", 3)    'gets the address of the last column in row 1
    dat.Range("A2:" & col(1) & datLR).Replace what:="ORCATH", replacement:="CATH LAB"
    dat.Range("A2:" & col(1) & datLR).Replace what:="ZTREATMENT", replacement:="TRTRM"
    dataRmArr = mmaddins.RangeToArr1DUnique(dat.Range("B2:B" & datLR))
    rmArr = mmaddins.RangeToArr1DUnique(sch.Range("A2:A" & schLR))
    fltrArr = mmaddins.ComplimentaryArray(dataRmArr, rmArr)
    datLC = dat.[a1].End(xlToRight).Column
    dat.Range("A1:" & col(1) & datLR).AutoFilter Field:=24, Criteria1:="CANCELED", Operator:=xlOr, Criteria2:="ABORTED"
    If dat.Range("A1:A" & datLR).SpecialCells(xlCellTypeVisible).Count > 1 Then
        dat.Range("A2:" & col(1) & datLR).SpecialCells(xlCellTypeVisible).Delete shift:=xlShiftUp
    End If
    dat.Range("A1:" & col(1) & datLR).AutoFilter Field:=24
    If IsArray(fltrArr) Then
        dat.Range("A1:" & col(1) & datLR).AutoFilter Field:=2, Criteria1:=fltrArr, Operator:=xlFilterValues
    Else
        Debug.Print "Unable to remove non-tracked rooms from data."
        msg = "Unable to remove non-tracked rooms from data. Make sure to filter manually"
    End If
    If dat.Range("A1:A" & datLR).SpecialCells(xlCellTypeVisible).Count > 1 Then
        dat.Range("A2:" & col(1) & datLR).SpecialCells(xlCellTypeVisible).Delete shift:=xlShiftUp
    End If
    dat.UsedRange.AutoFilter
    datLR = dat.[a1].End(xlDown).Row
    For i = datLC To 1 Step -1
        Select Case dat.Cells(1, i).Value
        Case "CR URN", "ROOM", "DATE", "CATEGORY", "ANES. IN", "ANES. OUT", "PT. OUT ROOM", "SURGEON", "TURNOVER"
        Case Else
            col = Split(dat.Cells(1, i).Address, "$", 3)
            dat.Range(col(1) & "1:" & col(1) & datLR).Delete shift:=xlShiftToLeft
        End Select
    Next i
    dat.Rows("1:1").Font.Bold = True
    dat.Columns("A:" & col(1)).AutoFit
    Debug.Print Timer - t0 & "s"
    If msg <> "" Then
        MsgBox msg, vbInformation, "Data Preparation"
    End If
End Sub

 

[mmurrietta]

In case anyone is interested, I came up with a better way to do this than I had previously posted:

'returns array consisting of the contents of arr minus any of it's entries that were also in subArr'this function replaces the complimentaryArray function
'this function requires access to the IsInArray function (found in mmaddins.module1)
'ArrayMinusTest provides 6 tests on this function
tmp = ""
For i = LBound(arr) To UBound(arr)
    If IsInArray(CStr(arr(i)), subArr) = False Then
        tmp = tmp & arr(i) & vbLf
    End If
Next i
If Len(tmp) > 0 Then
    cnt = Len(tmp) - Len(Replace(tmp, vbLf, ""))
    tmp = StrReverse(Split(StrReverse(tmp), vbLf, 2)(1))
    tmp = Split(tmp, vbLf, cnt)
Else
    tmp = Array()
End If
ArrayMinus = tmp
End Function

Here's a quick test I created for it:

Sub ArrayMinusTest()
'tests for ArrayMinus function
Debug.Print
Debug.Print "Begin ArrayMinusTest---------------------------------------"
'test with an overlap
arr = Array("You", "Me", "We")
otherArr = Array("we", "they")
tstArr = ArrayMinus(arr, otherArr)
fail = False
failCnt = 0
testCnt = 0
If tstArr(0) <> "You" Then
    fail = True
End If
If tstArr(1) <> "Me" Then
    fail = True
End If
Debug.Print "Overlap test result: fail = " & fail
testCnt = testCnt + 1
If fail = True Then
    failCnt = failCnt + 1
End If


'test with no overlap
arr = Array("You", "Me", "We")
otherArr = Array("see", "they")
tstArr = ArrayMinus(arr, otherArr)
fail = False
If tstArr(0) <> "You" Then
    fail = True
End If
If tstArr(1) <> "Me" Then
    fail = True
End If
If tstArr(2) <> "We" Then
    fail = True
End If
Debug.Print "No Overlap test result: fail = " & fail
testCnt = testCnt + 1
If fail = True Then
    failCnt = failCnt + 1
End If


'test with full overlap
arr = Array("You", "Me", "We")
otherArr = Array("You", "Me", "We")
tstArr = ArrayMinus(arr, otherArr)
fail = False
If Not (LBound(tstArr) = 0 And UBound(tstArr) = -1) Then
    fail = True
End If
Debug.Print "Full Overlap test result: fail = " & fail
testCnt = testCnt + 1
If fail = True Then
    failCnt = failCnt + 1
End If


'test with empty arrays
arr = Array()
otherArr = Array()
tstArr = ArrayMinus(arr, otherArr)
fail = False
If Not (LBound(tstArr) = 0 And UBound(tstArr) = -1) Then
    fail = True
End If
Debug.Print "Both Empty Arrays test result: fail = " & fail
testCnt = testCnt + 1
If fail = True Then
    failCnt = failCnt + 1
End If


'test with main array empty
arr = Array()
otherArr = Array("You", "Me", "We")
tstArr = ArrayMinus(arr, otherArr)
fail = False
If Not (LBound(tstArr) = 0 And UBound(tstArr) = -1) Then
    fail = True
End If
Debug.Print "Main Array Empty test result: fail = " & fail
testCnt = testCnt + 1
If fail = True Then
    failCnt = failCnt + 1
End If


'test with minus array empty
arr = Array("You", "Me", "We")
otherArr = Array()
tstArr = ArrayMinus(arr, otherArr)
fail = False
If Not (LBound(tstArr) = LBound(arr) And UBound(tstArr) = UBound(arr)) Then
    fail = True
End If
Debug.Print "Minus Array test result: fail = " & fail
testCnt = testCnt + 1
If fail = True Then
    failCnt = failCnt + 1
End If


Debug.Print
Debug.Print "Failed " & failCnt & " out of " & testCnt & " tests."
Debug.Print "End ArrayMinusTest---------------------------------------"
End Sub

 

[Pranesh]

I ran into this problem recently. The .autofilter only has 2 criteria you can use and using an array for the criteria doesn’t allow you to use the “<>Name1” format. So we are stuck for a quick way to deselect multiple items with the autofilter. I was able to find a work around.

In my case, I need to generate a daily transaction activity report for financial accounts. I start with unformatted data and use VBA to format it. Column C lists the activity types for each of the transactions. I am not interested in a few of the types and I wanted to be able to deselect them in the autofilter using vba. There are a large number of possible types that can be used and occasionally types show up that I haven’t encountered before. Because of this, writing code to select all of the possible types was not an option, especially since I would have to check the results every day to make sure new codes weren’t missed.

I was able to get around this problem by storing all the activity types I didn’t want to see in an array. Then I looped through all of the activity types in the report and compared them to my array; if they weren’t in the array I added them to a second array. I then used the second array as the criteria in the autofilter.

    'apply a filter, row 1 contains my titles
    Range("A1:L1").Select
    Selection.AutoFilter
 
    Dim filterCriteria() As String
    Dim count As Long, secondArray As Variant
    Dim L As Long, c As String, k As String, rowNumb As Long
   
    secArray = Array("Type1", " Type2", " Type3", " Type4")
   
    c = 0
    k = 0
    count = 0
    rowNumb = ActiveSheet.Range(ActiveSheet.Range("C2"), ActiveSheet.Range("C1").End(xlDown)).Rows.count
   
    For L = 1 To rowNumb
        c = ActiveSheet.Range("C1").Offset(L)
        If c <> k Then
            'check the current activity type against the array of types we don’t want. If it isn’t in the array we add it to an array that will be used as the filter criteria
            If UBound(Filter(secondArray, c)) = -1 Then
                ReDim Preserve filterCriteria(0 To count)
                filterCriteria(count) = c
                count = count + 1
            End If
 
            k = c
        End If
    Next
   
    With ActiveSheet
        .Range(.Range("A1"), .Range("A1").End(xlDown).Offset(0, 11)).AutoFilter Field:=3, Criteria1:=filterCriteria, Operator:=xlFilterValues
    End With

It would be faster without the loop but for what I need it works.

Hi,

I applied this code and it really works perfectly to me when my second array list is 8, However now I have 25 item list as array while I include those in my second array its is not filtering correct. Any suggestions?

 

[mmurrietta]

Pranuvins, put parentheses around your array like so:

.range(.range("A1"), .range("A1").end(xldown).offset(0,11)).autofilter field:=3,criteria1:=(filterCriteria), operator:=xlfiltervalues