Tweak code - filter multiple sheets

[MOB]

I have this code which works, but I need to finesse it;

Sub filtersheets()
Dim xWs As Worksheet
On Error Resume Next
For Each xWs In Worksheets
xWs.Range("b4").AutoFilter 2, Sheets("total").Range("C1")
Next
End Sub

What I want to change;

- if C1 contains "ALL" it unfilters
- any change to cell C1 triggers the event, rather than having to run a macro
- code runs on every sheet except "TOTAL"

TIA

 

[dmt32]

Hi,
Untested but try this update to your code

Standard Module

Sub filtersheets(ByVal sh As Object)
    Dim xWs As Worksheet
    Dim FilterCriteria As String
    
    FilterCriteria = sh.Range("C1").Value
    
    On Error Resume Next
    For Each xWs In Worksheets
        If FilterCriteria = "All" Then
            xWs.Range("b4").AutoFilter
        Else
        If xWs.Name <> sh.Name Then xWs.Range("b4").AutoFilter 2, FilterCriteria
        End If
    Next
    On Error GoTo 0
End Sub

Your total sheets code page

Private Sub Worksheet_Change(ByVal Target As Range)
 filtersheets Me
End Sub

Solution assumes change of values in C1 are other than by formula

Hope Helpful

Dave

 

[MOB]

Nearly perfect;

Entering "ALL" tries to filter by that text, I need it to unfilter/show all if "ALL" is entered.

Thanks

 

[dmt32]

Perfect, thanks

Most welcome

Dave

 

[MOB]

Most welcome

Dave

Sorry, nearly perfect;

Entering "ALL" tries to filter by that text, I need it to unfilter/show all if "ALL" is entered.

Thanks

 

[MOB]

Its ok I've just realised the word "ALL" is case sensitive

Thanks again!

 

[dmt32]

Try this update

Sub filtersheets(ByVal sh As Object)
    Dim xWs As Worksheet
    Dim FilterCriteria As String
    
    FilterCriteria = sh.Range("C1").Value
    If Len(FilterCriteria) = 0 Then Exit Sub
    
    On Error Resume Next
    For Each xWs In Worksheets
        With xWs
            If UCase(FilterCriteria) = "ALL" Then
             If .FilterMode Then .ShowAllData
            Else
                If .Name <> sh.Name Then .Range("b4").AutoFilter 2, FilterCriteria
            End If
        End With
    Next
    On Error GoTo 0
End Sub

Dave