Conditionele Opmaak

[madref]

Ik gebruik onderstaande code om kleurtjes te geven aan cellen

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim x As Range
'met volgende regel bepaal je de range voor de opmaak
  If Intersect(Target, [J3:J500]) Is Nothing Then Exit Sub
  For Each x In Target
    Select Case x
'Hier vorden de verschillende diensten een bepaalde kleur gegeven
'Blauw = 5
'Groen = 4
'Rood = 3
      Case "VALID": x.Interior.ColorIndex = 4
                 x.Font.ColorIndex = 1
      Case "EXPIRED": x.Interior.ColorIndex = 3
                 x.Font.ColorIndex = 1
      Case Else:    x.Interior.ColorIndex = xlNone
                    x.Font.ColorIndex = 1
    End Select
  Next
End Sub

Het probleem is dat ik kijk naar de J-kolom, maar dat de kleuren in de K-kolom moeten veranderen.
Met deze code red ik het niet.
Hoe moet ik dit oplossen?

 

[Cobbe]

x.Offset(,1).Interior.ColorIndex = 4

 

[edmoor]

Oftewel:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim x As Range, kleur As Long
    [COLOR="#008000"]'met volgende regel bepaal je de range voor de opmaak[/COLOR]
    If Intersect(Target, [J3:J500]) Is Nothing Then Exit Sub
    For Each x In Target
        Select Case x
[COLOR="#008000"]            'Hier worden de verschillende diensten een bepaalde kleur gegeven
            'Blauw = 5
            'Groen = 4
            'Rood = 3[/COLOR]
             Case "VALID":   kleur = 4
             Case "EXPIRED": kleur = 3
             Case Else:      kleur = xlNone
        End Select
    
        With x.Offset(, 1)
            .Interior.ColorIndex = kleur
            .Font.ColorIndex = 1
        End With
    Next
End Sub

 

[madref]

Dank je wel allemaal

 

[madref]

Hmmm... is niet helemaal wat ik bedoel.
De J-kolom bevat een datum en in de K-kolom komt er dan VALID of EXPIRED te staan middels deze formule :

=ALS(J5="";"";ALS(J5>=VANDAAG();"VALID";"EXPIRED"))

Dus als de J-kolom veranderd, dan moet er gekeken worden naar de K-kolom en afhankelijk van die inhoud moet de kleur veranderen in rood of groen.

 

[edmoor]

Zo staat dat niet in je eerste vraag en ook niet in je code. En dat is nu juist de reden dat we altijd zo om een voorbeeld document "zeuren". De code die ik plaatste in #3 kan je er natuurlijk wel simpel op aanpassen.

 

[Cobbe]

Een vraag fatsoenlijk formuleren is zeer vaak lastiger dan een oplossing zoeken.

 

[madref]

Ja ja ja .... dat weet ik ook wel. Maar dat hoef je niet in te wrijven.

 

[edmoor]

Mee eens. Probeer deze eens:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim x As Range, kleur As Long
    [COLOR="#008000"]'Met volgende regel bepaal je de range voor de opmaak[/COLOR]
    If Intersect(Target, [J3:J500]) Is Nothing Then Exit Sub
    For Each x In Target
       [COLOR="#FF0000"] Select Case x.Offset(, 1)[/COLOR]
[COLOR="#008000"]            'Hier worden de verschillende diensten een bepaalde kleur gegeven
            'Blauw = 5
            'Groen = 4
            'Rood = 3[/COLOR]
             Case "VALID":   kleur = 4
             Case "EXPIRED": kleur = 3
             Case Else:      kleur = xlNone
        End Select
    
        With x.Offset(, 1)
            .Interior.ColorIndex = kleur
            .Font.ColorIndex = 1
        End With
    Next
End Sub

 

[madref]

Dank je wel.. Nu werkt het perfect.

 

[edmoor]

Ok dan

 

[mastermindzh]

Ik heb de discussie maar even verwijderd aangezien dat de vraag wat makkelijker leesbaar maakt

@madref
Een beetje respect voor de helpers mag wel hoor.
Maarliefst tweemaal komt er een antwoord binnen 15 minuten naar buiten.
Dat mag gewaardeerd worden

@allen
Prettige dag verder :thumb: