Voorwaardelijke opmaak via VBA

[embetwee]

Hallo,

Ik gebruik het onderstaande via 'Helpmij' verkregen stukje code om, afhankelijk van de celwaarde of celtekst, die cel een bepaalde kleur toe te kennen. Lege cellen 'ziet' Excel echter als cellen met waarde nul zodat hij deze geel kleurt, waar ik die gewoon wit (colorindex 0) wil hebben. Kan iemand mij vertellen hoe ik de code kan uitbreiden zodat dit bereikt wordt? Bij voorbaat dank!


Sub inkleuren()
Application.ScreenUpdating = False
'Eventueel de bladbeveliging uitschakelen om kleuren toe te voegen: ActiveSheet.Unprotect Password:="?"

Dim cell_in_loop As Range
For Each cell_in_loop In Range("A1:A1000")
With cell_in_loop
Select Case .Value
Case -180 To -31: .Interior.ColorIndex = 4
Case -30 To -1: .Interior.ColorIndex = 37
Case 0 To 90: .Interior.ColorIndex = 6
Case 91 To 360: .Interior.ColorIndex = 26
Case "ING": .Interior.ColorIndex = 3
End Select
End With
Next
Application.ScreenUpdating = True
End Sub

 

[Jan van Asseldonk]

Aangepaste versie:

Sub inkleuren()
Application.ScreenUpdating = False
'Eventueel de bladbeveliging uitschakelen om kleuren toe te voegen: ActiveSheet.Unprotect Password:="?"

Dim cell_in_loop As Range
For Each cell_in_loop In Range("A1:A100")
   [B] If Not IsEmpty(cell_in_loop) Then[/B]
        With cell_in_loop
            Select Case .Value
                Case -180 To -31: .Interior.ColorIndex = 4
                Case -30 To -1: .Interior.ColorIndex = 37
                Case 0 To 90: .Interior.ColorIndex = 6
                Case 91 To 360: .Interior.ColorIndex = 26
                Case "ING": .Interior.ColorIndex = 3
            End Select
        End With
    [B]End If[/B]
Next
Application.ScreenUpdating = True
End Sub

Voeg vetgedrukte toe.

 

[embetwee]

Yes!!

Geweldig Jan, you just made my day! Hartstikke bedankt!

Embetwee