Gefilterde cellen andere kleur geven via VBA

[Peekhamer]

Als ik in een werkblad filters heb aanstaan dan is het lastig te zien waar de filter nu echt aanstaat. Excel versie = 2016.
De data is samengevat in een List / tabel.

Is het mogelijk om VBA code te maken en die die cellen te laten kleuren waarop een filter actief is?
Heb al wat zitten zoeken maar ben OF hele lappen code tegengekomen OF het is niet wat ik bedoel.
Ik vermoed dat dit niet eenvoudig te regelen is of vergis ik me?

Check of op een kopcel een filter actief is; zo ja andere kleur, zo nee geen opvulling.
Filter weer uit is kleur weer wissen.
Maakt het nog verschil dat het hier een tabel betreft?

 

[Cobbe]

Ik vermoed dat dit vrij eenvoudig te regelen moet zijn lijkt me?

Wij doen hier enkel moeilijke gevallen.

 

[Peekhamer]

fixed

 

[Peekhamer]

Heeft iemand een suggestie?

 

[sylvester-ponte]

plaats eens een voorbeeldbestand ? dat werkt makkerllijker.

 

[Peekhamer]

Bij deze een heel klein vb bestandje

De bedoeling is dat ik vba code in mijn personal kan opslaan zodat in iedere geopende werkmap een gefilterde cel in afwijkende kleur wordt weergegeven.

 

[VenA]

Probeer het zo eens.

Sub VenA()
With ActiveSheet
    If .AutoFilterMode Then
        For Each flt In .AutoFilter.Filters
            j = j + 1
            .Cells(1, j).Interior.Color = IIf(flt.On, vbRed, xlNone)
        Next flt
    End If
End With
End Sub

 

[Peekhamer]

Thankx, top, dit werkt voor normale autofilter. Enige puntje is dat hij 'handmatig' moet worden aangeroepen maar nu ik m in de bladmodule heb gezet als Worksheet Change event, werkt het goed.

In tabelvorm doet hij het echter (nog) niet. Heet de filtermodus die hier standaard op zit dan geen autofilter?

 

[Peekhamer]

al wat verder gekomen; filter op een tabel is een ListObject en geen paginafilter dus even verder puzzelen.

 

[Peekhamer]

Ik heb m voor ListObjects inmiddels ook; zie hieronder:

Sub WorkSheet_SelectionChange(ByVal Target As Range)

Application.ScreenUpdating = False

With ActiveSheet.ListObjects(1).AutoFilter
    If .FilterMode Then
        For Each flt In AutoFilter.Filters
            j = j + 1
            .Range(1, j).Interior.Color = IIf(flt.On, vbGreen, xlNone)
        Next flt
        
    End If
End With

Application.ScreenUpdating = True
End Sub

Enige puntje is dat de laatste cel waar de filter wordt uitgezet niet meer "terugkleurt" naar niets en dat snap ik niet?? Dan verandert er toch ook wat?

 

[HSV]

Als je het bestand had geplaatst met het listobject, hadden we mee kunnen kijken.

 

[Peekhamer]

Bij deze dan ook met een List erin, samen met de code (alleen voor list) die ik nu heb.

Het gekke is dat hij de laatste cel niet 'ontkleurt'?

Edit: ik denk dat dat komt omdat de code dan ziet dat er geen filters actief zijn en dus niet 'runt' ... de ".if filtermode" is dan onwaar.
Edit2: als ik die ".if filtermode" eruit haal werkt het zoals bedoeld. Code wordt dan:

Sub WorkSheet_SelectionChange(ByVal Target As Range)

Application.ScreenUpdating = False

With ActiveSheet.ListObjects(1).AutoFilter
        For Each flt In AutoFilter.Filters
            j = j + 1
            .Range(1, j).Interior.Color = IIf(flt.On, vbGreen, xlNone)
        Next flt
End With

Application.ScreenUpdating = True
End Sub

Opgelost.