Excel VBA Course
Excel VBA Course - From Beginner to Expert

200+ Video Lessons
50+ Hours of Video
200+ Excel Guides

Become a master of VBA and Macros in Excel and learn how to automate all of your tasks in Excel with this online course. (No VBA experience required.)

View Course

How to make one filter mirror anothers selections

0

I have a spreadsheet with two sheets that are identical for the first 3 columns

ex. Manager, Market, Market number

Both have filters for the same columns and identical criteria ex. 'Sheet1'!A2:C60 = 'Sheet2'!A3:C61 with different data associated to each row on the right

I would like to have it set up where whatever selections I make on Sheet1's filters are automatically selected on Sheet2's filters, so the manager doesn't have to go through both filters making the same selections

I tried using advanced filters, but it kept saying it had to be on the same sheet. (not experienced with advanced filters)

What would be the best solution to this issue? I realize it's a lot, just so people don't have to filter twice.

Answer
Discuss

Discussion

I updated the answer with info on how to install it and make it run.
don (rep: 1989) Jul 14, '16 at 11:54 am
Add to Discussion

Answers

1
Selected Answer

Lucky man, I didn't even know this would be possible but I found the perfect macro for you.

Sub AutoFilter_All_Sheets()

    Dim objSheet As Worksheet, objMainSheet As Worksheet
    Dim arrAllFilters() As Variant
    Dim byteCountFilter As Byte, i As Byte

    Set objMainSheet = ActiveSheet

    If insertAllFilters(arrAllFilters, byteCountFilter) Then

        Application.ScreenUpdating = False
        For Each objSheet In ActiveWorkbook.Worksheets
             'Skip the starting sheet
            If objSheet.Name <> objMainSheet.Name Then

                On Error GoTo errhandler
                 'check Autofilter, if one is off = switch on
                objSheet.Select
                objSheet.AutoFilterMode = False 'clear existing filtering
                If Not objSheet.AutoFilterMode Then
                     ' if sheet doesn't contain some data
                    Range(arrAllFilters(4, 1)).AutoFilter
                End If

                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)

                     'Filter 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
        For Each objSheet In ActiveWorkbook.Worksheets
            If objSheet.Name <> objMainSheet.Name Then
                objSheet.Activate
                objSheet.AutoFilterMode = False
            End If
        Next objSheet

        If Not objMainSheet.AutoFilterMode Then
             'Main Sheet doesn't contain data or Autofilter is off
            MsgBox "Sheet (Name """ & objMainSheet.Name & """) doesn't contain data or the Autofilter is off!" _
                & vbCrLf & "This code can't continue.", vbCritical, "Missing Autofilter object or filter item"
        End If
        Set objMainSheet = Nothing
        Set objSheet = Nothing

        Application.ScreenUpdating = True

        Exit Sub
    End If

    objMainSheet.Activate
    Set objMainSheet = Nothing
    Set objSheet = Nothing

    Application.ScreenUpdating = True

    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 Variant, 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
    Dim x As Variant

    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 & doesn't 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
    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

                On Error Resume Next
                x = myFilter.Criteria2
                If Err.Number = 0 Then 'Criteria2 exists
                    On Error GoTo 0 'errorhandler
                    If myFilter.Operator <> 0 Then
                        arrAllFilters(3, i) = myFilter.Criteria2
                    End If
                End If
                On Error GoTo 0
                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

I tested the above macro and it works. The only thing is that it will try to apply the filter to EVERY worksheet in the workbook.

If you just want this to apply to a specific other worksheet and not the rest of the entire workbook then use this macro (slightly edited from the last version):

Sub AutoFilter_All_Sheets()

    Dim objSheet As Worksheet, objMainSheet As Worksheet
    Dim arrAllFilters() As Variant
    Dim byteCountFilter As Byte, i As Byte

    Set objMainSheet = ActiveSheet

    'Sheet where you want the filter to work
    filter_paste_sheet = "NAME OF YOUR WORKSHEET"

    If insertAllFilters(arrAllFilters, byteCountFilter) Then

        Application.ScreenUpdating = False
        For Each objSheet In ActiveWorkbook.Worksheets
             'Skip the starting sheet
            If objSheet.Name = filter_paste_sheet Then

                On Error GoTo errhandler
                 'check Autofilter, if one is off = switch on
                objSheet.Select
                objSheet.AutoFilterMode = False 'clear existing filtering
                If Not objSheet.AutoFilterMode Then
                     ' if sheet doesn't contain some data
                    Range(arrAllFilters(4, 1)).AutoFilter
                End If

                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)

                     'Filter 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
        For Each objSheet In ActiveWorkbook.Worksheets
            If objSheet.Name = filter_paste_sheet Then
                objSheet.Activate
                objSheet.AutoFilterMode = False
            End If
        Next objSheet

        If Not objMainSheet.AutoFilterMode Then
             'Main Sheet doesn't contain data or Autofilter is off
            MsgBox "Sheet (Name """ & objMainSheet.Name & """) doesn't contain data or the Autofilter is off!" _
                & vbCrLf & "This code can't continue.", vbCritical, "Missing Autofilter object or filter item"
        End If
        Set objMainSheet = Nothing
        Set objSheet = Nothing

        Application.ScreenUpdating = True

        Exit Sub
    End If

    objMainSheet.Activate
    Set objMainSheet = Nothing
    Set objSheet = Nothing

    Application.ScreenUpdating = True

    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 Variant, 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
    Dim x As Variant

    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 & doesn't 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
    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

                On Error Resume Next
                x = myFilter.Criteria2
                If Err.Number = 0 Then 'Criteria2 exists
                    On Error GoTo 0 'errorhandler
                    If myFilter.Operator <> 0 Then
                        arrAllFilters(3, i) = myFilter.Criteria2
                    End If
                End If
                On Error GoTo 0
                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

To use this one, replace NAME OF YOUR WORKSHEET with the worksheet where you want the filtered options to be copied.

Install the macro into a module - here is a tutorial on how to get a macro into Excel.

This macro will not run automatically though. I suggest that you put a small button on the page that allows the user to copy the filter to the other page or a button in the quick access toolbar. Here is a tutorial on how to attach a macro to a button.

Discuss

Discussion

Thank you! I'm also not very experienced in macros, where do I insert this code in the VBAProject?
MikeH561 (rep: 2) Jul 14, '16 at 11:50 am
Answer updated with the info.
don (rep: 1989) Jul 14, '16 at 11:51 am
Awesome! Thank you again! It's working for me. However, on the sheet that is autofiltered, the header of the page is 3 rows deep. When the macro runs, rows 2-3 are hidden. Is there something in the code that can be changed so that all 3 rows are displayed at the top?
MikeH561 (rep: 2) Jul 14, '16 at 12:13 pm
The macro uses Excel's automatic filter feature to get the filter to attach to the data so I don't think this can be changed in the macro. It works the same way as it does if you go to the worksheet, click a cell in the table of data and then click the Filter button.
I recommend merging the top three rows into one or altering your spreadsheet in another way so it looks nice and retains functionality. It doesn't seem like there is another way to do this with this code.
don (rep: 1989) Jul 14, '16 at 12:30 pm
is there not some sort of coordinates that can be changed from a 1 to a 3 so that the code is activated 2 rows further down?
MikeH561 (rep: 2) Jul 14, '16 at 12:51 pm
Add to Discussion


Answer the Question

You must create an account to use the forum. Create an Account or Login