VBA Autofilter multiple sheets: Increase filter for more than 2

[Darms]

Hi there.

I have 2600 rows of manager data that require filtering over multiple worksheets.

I found the code below from the following website:

http://www.ozgrid.com/forum/showthread.php?t=76618&page=1

I attached it to a command button, so when select one manager, if filters that manager's name across the eight worksheets that I have. Great!

HOWEVER, if I try to filter more than 2 names (3 or above), I receive the following error msg:

"Main Sheet doesn't some data or it doesn't use !"

So obviously the code is built to autofilter no more than two results across the worksheets. I tried playing with the code to see if I can increase it, but I cannot figure out what to change.

Can anyone please help (I highlighted in blue what I think is the code that needs to change). ?

Sub filter_All_Sheets() 
     
    Dim objSheet As Worksheet, objMAinSheet As Worksheet 
    Dim arrAllFilters() As String 
    Dim byteCountFilter As Byte, i As Byte 
     
    Set objMAinSheet = ActiveSheet 
     ' insert all criteria and address
    If insertAllFilters(arrAllFilters, byteCountFilter) Then 
         
        Application.ScreenUpdating = False 
         ' If is allright, go on
        For Each objSheet In ActiveWorkbook.Worksheets 
             ' don't do on same sheet
            If objSheet.Name <> objMAinSheet.Name Then 
                 
                On Error Goto errhandler 
                 'check Autofilter, if one is off = switch on
                objSheet.Select 
                If Not objSheet.AutoFilterMode Then 
                     ' if sheet doesn't contain some data
                    Range(arrAllFilters(4, 1)).AutoFilter 
                End If 
                 
                 ' here I know taht Autofilter is On
                 ' filter some item
               [COLOR=blue] For i = 1 To byteCountFilter 
                     ' only 1 criteria (without Operator)
                    If arrAllFilters(2, i) = 0 Then 
                        Range(arrAllFilters(4, i)).AutoFilter _ 
                        Field:=Range(arrAllFilters(4, i)).Column, _ 
                        Criteria1:=arrAllFilters(1, i) 
                         ' with operator
                    ElseIf arrAllFilters(2, i) <> 0 Then 
                        Range(arrAllFilters(4, i)).AutoFilter _ 
                        Field:=Range(arrAllFilters(4, i)).Column, _ 
                        Criteria1:=arrAllFilters(1, i), _ 
                        Operator:=arrAllFilters(2, i), _ 
                        Criteria2:=arrAllFilters(3, i) 
                    End If 
[/COLOR]                Next i 
                 
            End If 
        Next objSheet 
    Else 
         'While Main Sheet doesn't contain data or Autofilter is off
        MsgBox "Main Sheet (Name """ & objMAinSheet.Name & """) doesn't some data or it doesn't use !" _ 
        & vbCrLf & "This code can't go on.", vbCritical, "Missing Autofilter object or filter item " 
         
        Set objMAinSheet = Nothing 
        Set objSheet = Nothing 
         
        Application.ScreenUpdating = True 
         
        Exit Sub 
    End If 
     
    objMAinSheet.Activate 
    Set objMAinSheet = Nothing 
    Set objSheet = Nothing 
     
    Application.ScreenUpdating = True 
     
    MsgBox "Finished" 
    Exit Sub 
     
errhandler: 
    Set objMAinSheet = Nothing 
    Set objSheet = Nothing 
     
    Application.ScreenUpdating = True 
     
    If Err.Number = 1004 Then 
        MsgBox "Probable cause of error - sheet dosn't contain some data", vbCritical, "Error Exception on sheet " & ActiveSheet.Name 
    Else 
        MsgBox "Sorry, run exception" 
    End If 
     
End Sub 
Function insertAllFilters(arrAllFilters() As String, byteCountFilter As Byte) As Boolean 
     ' go throught all filters and inserting their address and criterial
    Dim myFilter As Filter 
    Dim myFilterRange As Range 
    Dim boolFilterOn As Boolean 
    Dim i As Byte, byteColumn As Byte 
     
    boolFilterOn = False: i = 0: byteColumn = 0 
     ' If AutoFilter is off - return False
    If Not ActiveSheet.AutoFilterMode Then 
        insertAllFilters = False 
        Exit Function 
    End If 
     
     ' If Autofilter is on & no filter any item = return false
    For Each myFilter In ActiveSheet.AutoFilter.Filters 
        If myFilter.On Then 
            boolFilterOn = True 
            Exit For 
        End If 
    Next myFilter 
     ' Check Filter
    If Not boolFilterOn Then 
        insertAllFilters = False 
        Exit Function 
    End If 
     
    On Error Goto errhandler 
     ' here is all control done
    With ActiveSheet.AutoFilter 
        For Each myFilter In .Filters 
            byteColumn = byteColumn + 1 
            If myFilter.On Then 
                i = i + 1 
                Redim Preserve arrAllFilters(1 To 4, 1 To i) 
                arrAllFilters(1, i) = myFilter.Criteria1 
                arrAllFilters(2, i) = myFilter.Operator 
                If myFilter.Operator <> 0 Then 
                    arrAllFilters(3, i) = myFilter.Criteria2 
                End If 
                arrAllFilters(4, i) = .Range.Columns(byteColumn).Cells(1).Address 
            End If 
        Next myFilter 
    End With 
     
    byteCountFilter = i 
    insertAllFilters = True 
    Set myFilter = Nothing 
    Set myFilterRange = Nothing 
    Exit Function 
     
errhandler: 
    insertAllFilters = False 
    Set myFilter = Nothing 
    Set myFilterRange = Nothing 
     
End Function

 

[Andrew Poulsom]

You can only have 2 AutoFilter criteria for a column, manually or in VBA. To use more than 2 criteria you would have to use Advanced Filter.

 

[Darms]

Thanks for your response Andrew.

Forgive my ignorance, but is there a way to implement the Advanced Filter into the attached code?

 

[Andrew Poulsom]

Thanks for your response Andrew.

Forgive my ignorance, but is there a way to implement the Advanced Filter into the attached code?

Not really, no. It would require a complete rewrite.

 

[Darms]

Ha... OK thanks Andrew, I appreciate it.