VBA: Autofilter Criteria

[rjwebgraphix]

Current version is XL2010. This is a modified recorded macro. The following code works for the current data on the current sheet, but that changes daily and can even change between sheets. When I recorded the macro I deselected the lines using the filter that I didn't want to see, but the code shows the lines I do want to see.

In this case we're talking about the line of criteria for Pig, Cat, Dog... etc. But I deselected Bear and Frog. Is there a simple way to reverse the criteria to be the ones I don't want to see instead of the ones I do want to see in the code or will I have to build the array myself outside of the Autofilter and pass in the array for the ones I do want to see?

The lines I don't want to see are fairly static. They will always be Bear and Frog, but Bear or Frog might not be present in the data at all.

Thanks, RJ

Sub forumwork()


Dim OARsht As Worksheet
Set OARsht = Sheets("TGS OARV")

Dim lr As Long
Dim c1 As Range
Dim c2 As Range
Dim rng As Range

lr = OARsht.Range("A65536").End(xlUp).Row
Set c1 = Cells(1, "A")
Set c2 = Cells(lr, "F")
Set rng = Range(c1, c2)

    rng.AutoFilter
    rng.AutoFilter Field:=3, Criteria1:=Array( _
        "Pig", "Cat", "Dog", _
        "Elephant", "Mouse", "Lion", _
        "Monkey"), Operator:=xlFilterValues


End Sub

 

[jbeaucaire]

The Autofilter by design allows two separate filters to be used when you want to be specific, and it sounds like you only have two criteria. "<>Bear" and "<>Frog", anymore and this simple solution wouldn't work:

rng..AutoFilter Field:=3, Criteria1:="<>Bear", Operator:=xlAnd, Criteria2:="<>Frog"

If it's more than 3, you would need to build the array specifically excluding the known values, then feed that array into your original method.

 

[rjwebgraphix]

If it's more than 3, you would need to build the array specifically excluding the known values, then feed that array into your original method.

Can I use the array method with the not operator? IE: <>array

Currently there are 5. Bear and Frog were just used as examples. That could vary in the future and need the ability to add more.

 

[jbeaucaire]

As I said, if it's more than 2, then you will be creating your array separately and feeding that into your original code.

 

[rjwebgraphix]

As I said, if it's more than 2, then you will be creating your array separately and feeding that into your original code.

Thanks for the info. This is the end result, unless you see a better way of doing it.

I pulled out an old function from another project to build a unique array and modified it to allow for an exclusion of items to add to the array. Here's that function:

Public Function  UniqueItems(ArrayIn, Optional Add2Arr As Variant, Optional ExcludeArr As  Variant, Optional count As Variant) As Variant
    
Dim Unique() As Variant
Dim Element As Variant
Dim i As Long
Dim NumUnique As Long
Dim IsInArray As Boolean
Dim Excluded As Variant

       
'Only do a count of unique items in array or range
If IsMissing(count) Then count = False

'Add unique items to this existing array
If Not IsMissing(Add2Arr) Then
    Unique = Add2Arr
    NumUnique = UBound(Add2Arr) + 1
End If
        

For Each Element In ArrayIn
    IsInArray = False
    'Exclude these array items for unique array
    If Not IsMissing(ExcludeArr) Then
        For Each Excluded In ExcludeArr
            If Element = Excluded Then
                IsInArray = True
            End If
        Next Excluded
    Else
        ' If Arr has not been established, skip the loop
        If Not ((Not Unique) = -1) Then
            For i = LBound(Unique) To UBound(Unique)
                If Element = Unique(i) Then
                    IsInArray = True
                    Exit For
                End If
            Next i
        End If
    End If
    
    If IsInArray = False And Element <> "" Then
        ReDim Preserve Unique(NumUnique)
        Unique(NumUnique) = Element
        NumUnique = NumUnique + 1
        IsInArray = True
    End If
Next Element


If count Then UniqueItems = NumUnique Else UniqueItems = Unique

End Function

Then in my code I just build an array of items to exclude, which in turn gives me the whole list of what to include.

Sub CleanUpOars()
    
Dim OARsht As Worksheet


Dim lr As Long
Dim c1 As Range
Dim c2 As Range
Dim rng As Range

Dim UniErrArr As Variant
Dim ExcludeErrArr(0 To 4) As Variant

'Exclude operator messages from Error messages
ExcludeErrArr(0) = "Operator msg 1"
ExcludeErrArr(1) = "Operator msg 2"
ExcludeErrArr(2) = "Operator msg 3"
ExcludeErrArr(3) = "Operator msg 4"
ExcludeErrArr(4) = "Operator msg 5"

Dim SortAndFilter As Boolean

Dim ws As Worksheet
For Each ws In Worksheets
    SortAndFilter = False
    If ws.Name = "TGS OARV" Then
        Set OARsht = Sheets("TGS OARV")
        SortAndFilter = True
    ElseIf ws.Name = "APRC OARV" Then
        Set OARsht = Sheets("APRC OARV")
        SortAndFilter = True
    ElseIf ws.Name = "STP1 OARV" Then
        Set OARsht = Sheets("STP1 OARV")
        SortAndFilter = True
    ElseIf ws.Name = "STP2 OARV" Then
        Set OARsht = Sheets("STP2 OARV")
        SortAndFilter = True
    End If
    If SortAndFilter = True Then
        lr = OARsht.Range("A65536").End(xlUp).Row
        Set c1 = OARsht.Cells(1, "A")
        Set c2 = OARsht.Cells(lr, "F")
        Set rng = OARsht.Range(c1, c2)
        
        'sort on date and time (same cell)
        OARsht.Sort.SortFields.Clear
        OARsht.Sort.SortFields.Add Key:=Range("A2:A" & lr), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
            xlSortNormal
        With OARsht.Sort
            .SetRange rng
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
            
        UniErrArr = UniqueItems(OARsht.Range("C2:C" & lr), , ExcludeErrArr)
        
        rng.AutoFilter
        rng.AutoFilter Field:=3, Criteria1:=UniErrArr, Operator:=xlFilterValues
        OARsht.Select
        ActiveCell.SpecialCells(xlLastCell).Select
    End If

Next ws

End Sub

Again, Thanks for the assistance with the autofilter.