Excel VBA - Filter Applied test

[simmerer]

Hi,
I have a spreadsheet with 45 columns. It is used to refine a data set. It is necessary to filter and sort in each step. For any one of several reasons I often apply a filter, then forget it is there. I am trying to write code that will change the color of the header row when any column is filtered, and change it back when the filter is removed from the column. The filter is always on, but not always applied.

I have this so far, but have a problem with selecting the range; it selects all rows captured in the filter and I just want the filter. I also would like it to be activated by applying a filter. In other words, when I apply a filter, the entire header/row 1 range becomes colored, and when I remove it, the color is removed.

Sub FilterCheck()
   Dim Sht As Worksheet
   Dim i As Long
   
   Set Sht = ActiveSheet
   
   With Sht.AutoFilter
      For i = 1 To .Filters.Count
         If .Filters(i).On Then
         Range("$A$1:$AS$85").Select
            With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
         End If
      Next i
   End With
End Sub

 

[Fluff]

Try

Sub FilterCheck()
   Dim Sht As Worksheet
   Dim i As Long
   Dim Rng As Range
   
   Set Sht = ActiveSheet
   
   Sht.Range("$A$1:$AS$85").Interior.Color = xlNone
   With Sht.AutoFilter
      For i = 1 To .Filters.Count
         If .Filters(i).On Then
            Set Rng = Intersect(Columns(i), Range("$A$1:$AS$85"))
            With Rng.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = 255
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
         End If
      Next i
   End With
End Sub

AFAIK there is no way to have this run automatically

 

[Peter_SSs]

Try this in a copy of your workbook.
Put the formula =SUBTOTAL(109,A2) in an unused cell, perhaps cell BA1. That column could then be hidden if you want.
Use the following Worksheet_Calculate event code. To implement ..
1. Right click the sheet name tab and choose "View Code".
2. Copy and Paste the code below into the main right hand pane that opens at step 1.
3. Close the Visual Basic window & test.

Private Sub Worksheet_Calculate()
  Dim c As Long
  Dim bFiltered As Boolean
  
  If ActiveSheet.AutoFilterMode Then
    With ActiveSheet.AutoFilter.Filters
      For c = 1 To .Count
        If .Item(c).On Then
          bFiltered = True
          Exit For
        End If
      Next c
    End With
    ActiveSheet.AutoFilter.Range.Rows(1).Interior.ColorIndex = -3 * bFiltered
  End If
End Sub

 

[simmerer]

Perfect! I filter and the headers change color. I take the filter of, and the color goes away. Exactly what I needed. I am slightly mystified by the value in BA1. It doesn't seem to change and it is not referenced in the code.

 

[Peter_SSs]

Perfect! I filter and the headers change color. I take the filter of, and the color goes away. Exactly what I needed.

Glad it worked for you.

I am slightly mystified by the value in BA1. It doesn't seem to change and it is not referenced in the code.

The formula references a cell in the filter range and it is forced to re-calculate when a filter is applied or removed, even if the result of the formula does not change. This re-calculation is what triggers the Worksheet_Calculate() event code that I provided.

 

[simmerer]

Glad it worked for you.


The formula references a cell in the filter range and it is forced to re-calculate when a filter is applied or removed, even if the result of the formula does not change. This re-calculation is what triggers the Worksheet_Calculate() event code that I provided.

Peter, I like this so much I can use it in other spreadsheets to help prevent errors. Some of those have a header color already (RGB 217, 217, 217). Can this return the original background instead of just clear it?

 

[Peter_SSs]

Some of those have a header color already (RGB 217, 217, 217). Can this return the original background instead of just clear it?

Sure, try this change.

<del>ActiveSheet.AutoFilter.Range.Rows(1).Interior.ColorIndex = -3 * bFiltered</del>
ActiveSheet.AutoFilter.Range.Rows(1).Interior.Color = IIf(bFiltered, vbRed, RGB(217, 217, 217))

 

[simmerer]

Sure, try this change.

<del>ActiveSheet.AutoFilter.Range.Rows(1).Interior.ColorIndex = -3 * bFiltered</del>
ActiveSheet.AutoFilter.Range.Rows(1).Interior.Color = IIf(bFiltered, vbRed, RGB(217, 217, 217))

Oh man, that is so groovy! Thanks

 

[Peter_SSs]

Oh man, that is so groovy! Thanks

You are welcome.