Filter Change In Worksheet Reflected In Another Worksheet

peddle
peddle used Ask the Experts™
on
I have a workbook with multiple worksheets. Each worksheet contains common column headings. Each worksheet has AutoFilters set. I want to be able to change the filter criteria in one worksheet and the other worksheets filters change to reflect the change. e.g. Worksheet a is filtered on Town "Bobsville"  so all the other worksheets will automatically change their filter criteria to filter on "Bobsville". Is this possible? I have a limitedknowledge of VBA if it could be done using that.
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
There you go......run this code after you filter...

Good Luck !
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
          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
          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

Open in new window

Commented:
Nice Code

Author

Commented:
Thanks for the quick responce and the code. Just one quick question! If I filter on Town = "Bobsville" and run the macro the value is correctly passed to the other worksheet filters. However when I clear the Town filter and run the macro I get the error

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 "

How can the code be changed to "unset" the criteria in the other worksheets?

Author

Commented:
Thanks, managed to modify the code above to unset the criteria if filter is cleared.

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial