Excel VBA: show column letter of which Column is filtered

[2Took]

Hi,

Below code works to identify that some column is filtered.
There will only be one column filtered at a time.

1. Need it to instead of the message box to populate into cell A6 value "X is filtered", where X is a letter of a column being filtered. Otherwise A6 to show value "nothing filtered". Wondering how taxing is it to have this running, I have it in Worksheet_SelectionChange.
2. For the X10 to fill with red background, where X is a letter of a column being filtered. (Once unfiltered, X10 needs to go back to prior color... but that color can vary, so this may not be feasible)...
3. Upon right click into A6 to select X10, where X is a letter of a column being filtered.

If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
MsgBox "filters on"
End If

 

[HaHoBe]

Hi 2Took,

you could try something like this:

Dim mlngIntCol      As Long
Dim mstrAddress     As String
'

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("A6")) Is Nothing Then
  If Not Target.Value = "nothing filtered" Then
    Application.EnableEvents = False
    Application.Goto Cells(10, Left(Target, InStr(Target, " ") - 1))
    Application.EnableEvents = True
  End If
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim objAF         As Object
  Dim objFlt        As Filter
  Dim strText       As String
  Dim lngFilter     As Long

  If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
    Set objAF = ActiveSheet.AutoFilter
    For lngFilter = 1 To objAF.Filters.Count
      Set objFlt = objAF.Filters(lngFilter)
      If objFlt.On Then
        mlngIntCol = objAF.Range.Cells(1, lngFilter).Interior.ColorIndex
        mstrAddress = Mid(objAF.Range.Cells(1, lngFilter).Address, 2)
        strText = Left(mstrAddress, InStr(mstrAddress, "$") - 1)
        objAF.Range.Cells(1, lngFilter).Interior.ColorIndex = 3
      End If
    Next lngFilter
  
    Range("A6").Value = strText & " is filtered"
    Set objFlt = Nothing
    Set objAF = Nothing
  
  Else
    Range("A6").Value = "nothing filtered"
    If Len(mstrAddress) > 0 Then Range(mstrAddress).Interior.ColorIndex = mlngIntCol
    mstrAddress = vbNullString
  End If

End Sub

But you can switch the Autofilter off without moving the cursor and this will not result in a correction of the value in A6.

Ciao,
Holger

 

[2Took]

Hi 2Took,

you could try something like this:

Dim mlngIntCol      As Long
Dim mstrAddress     As String
'

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("A6")) Is Nothing Then
  If Not Target.Value = "nothing filtered" Then
    Application.EnableEvents = False
    Application.Goto Cells(10, Left(Target, InStr(Target, " ") - 1))
    Application.EnableEvents = True
  End If
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim objAF         As Object
  Dim objFlt        As Filter
  Dim strText       As String
  Dim lngFilter     As Long

  If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
    Set objAF = ActiveSheet.AutoFilter
    For lngFilter = 1 To objAF.Filters.Count
      Set objFlt = objAF.Filters(lngFilter)
      If objFlt.On Then
        mlngIntCol = objAF.Range.Cells(1, lngFilter).Interior.ColorIndex
        mstrAddress = Mid(objAF.Range.Cells(1, lngFilter).Address, 2)
        strText = Left(mstrAddress, InStr(mstrAddress, "$") - 1)
        objAF.Range.Cells(1, lngFilter).Interior.ColorIndex = 3
      End If
    Next lngFilter
 
    Range("A6").Value = strText & " is filtered"
    Set objFlt = Nothing
    Set objAF = Nothing
 
  Else
    Range("A6").Value = "nothing filtered"
    If Len(mstrAddress) > 0 Then Range(mstrAddress).Interior.ColorIndex = mlngIntCol
    mstrAddress = vbNullString
  End If

End Sub

But you can switch the Autofilter off without moving the cursor and this will not result in a correction of the value in A6.

Ciao,
Holger

Thanks, Holger
But:
1. The color highlight for the filtered header cell, stays after that column is no longer filtered - whereas idea is for it to go back to original color once that column is no longer filtered. I am ending up with a bunch of red column header cells.
2. A6 did update with filtered column letter, but as you pointed out, wasn't consistent when filter was off (which I am doing by VBA), not switching to "nothing filtered".
3. Right clicking on A6 was taking me to the filtered header - which was great. But I also tried to get the code to Offset that selection to the next Visible cell below, but was unsuccessful. How would you accomplish that?
4. Then I reverted my edits out, and back to your original code, but right clicking stopped triggering any macros, even the ones I had before. I probably messed something up.

So I just went back to last saved file, so I could keep functionality that I had.

I think I'd be happy with a lite version of your code where only the populating of A6 with filtered column letter and right clicking on it would be taking to corresponding column header, but then also Offset that selection to the next Visible cell below. How would you accomplish that?
No highlighting and no "nothing filtered" in A6. If nothing filtered, then just keep A6 empty.

 

[HaHoBe]

Hi 2Took,

if the events are not triggered switch to the VBE, make the Immediate Window visible, write

Application.EnableEvents = True

and hit Enter.

Regarding the "lite" version

Dim mstrAddress     As String
'

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("A6")) Is Nothing Then
  If Not Target.Value = "nothing filtered" Then
    Application.EnableEvents = False
    Application.Goto Range(Cells(11, Left(Target, InStr(Target, " ") - 1)), _
        Cells(Rows.Count, Left(Target, InStr(Target, " ") - 1)).End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1)
    Application.EnableEvents = True
    Cancel = True
  End If
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim objAF         As Object
  Dim objFlt        As Filter
  Dim strText       As String
  Dim lngFilter     As Long

  If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
    Set objAF = ActiveSheet.AutoFilter
    For lngFilter = 1 To objAF.Filters.Count
      Set objFlt = objAF.Filters(lngFilter)
      If objFlt.On Then
        mstrAddress = Mid(objAF.Range.Cells(1, lngFilter).Address, 2)
        strText = Left(mstrAddress, InStr(mstrAddress, "$") - 1)
      End If
    Next lngFilter

    Range("A6").Value = strText & " is filtered"
    Set objFlt = Nothing
    Set objAF = Nothing

  Else
    Range("A6").Value = "nothing filtered"
  End If

End Sub

Ciao,
Holger