Kleur doortrekken naar rechts

[knarfje]

Hallo Excel alleskunners!

Dmv onderstaande code kan ik als er in een cel een 1 komt te staan de kleur aanpassen.

Nu wil ik graag dat die kleur word doorgetrokken in de cellen die er rechts naast staan mits er wat in die cellen staat.
Tevens heb ik nu problemen als ik de cel met de 1 "delete" dan blijven de kleuren behouden en dat wil ik niet.moet weer terug naar standaard.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [a1:G10]) Is Nothing Then
Select Case Target.Value
            Case "1"
                Target.Interior.ColorIndex = 6
                Target.Font.ColorIndex = 3
End Select
End If
End Sub

 

[danny147]

Beste knarfje

Waarom met een code

Als je in voorwaardelijke opmaak in cel A1 het volgende zet:

Celwaarde ----- gelijk aan-----1
Opmaak-----Geel.

Selecteer B1:F1 en geef de volgende formule in Voorwaardelijke Opmaak:

=EN(B1<>"";$A$1=1)

Zie anders bestandje.

Groetjes Danny. :thumb:

 

[knarfje]

Dit is een "uitgedund werkblad.

In werkelijkheid wil ik met meerde kleuren werken en zonder code kan dat maar met drie.

By the way:waar staat =EN voor in de formule =EN(B1<>"";$A$1=1)

 

[danny147]

Beste knarfje

Tenzij je met Excel 2007 werkt

Groetjes Danny. :thumb:

 

[knarfje]

Kan het ook met tekst?

Dus niet als er staat 1 maar bijvoorbeeld: pietje

 

[danny147]

Beste knarfje

Plak deze code in Blad 1 van je VBA editor.

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.ScreenUpdating = False
    'http://www.mvps.org/dmcritchie/excel/colors.htm'
    Dim cell_in_loop As Range
    For Each cell_in_loop In Range("A1:A100")
        With cell_in_loop
            Select Case .Value
                Case 1: .Interior.ColorIndex = 6
                Case 2: .Interior.ColorIndex = 48
                Case 3: .Interior.ColorIndex = 3
                Case 4: .Interior.ColorIndex = 4
                Case 5: .Interior.ColorIndex = 5
                Case 6: .Interior.ColorIndex = 44
                Case "": .Interior.ColorIndex = 0
            End Select
        End With
    Next
    Application.ScreenUpdating = True
End Sub

Beste als je de Case 1 verandert in Case "pietje" dan gaat het het als er pietje in de cel staat.

Groetjes Danny. :thumb:

 

[knarfje]

Beste als je de Case 1 verandert in Case "pietje" dan gaat het het als er pietje in de cel staat.

Je bedoeld zo??

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.ScreenUpdating = False
    'http://www.mvps.org/dmcritchie/excel/colors.htm'
    Dim cell_in_loop As Range
    For Each cell_in_loop In Range("A1:A100")
        With cell_in_loop
            Select Case .Value
                [B]Case pietje[/B]: .Interior.ColorIndex = 6
                Case 2: .Interior.ColorIndex = 48
                Case 3: .Interior.ColorIndex = 3
                Case 4: .Interior.ColorIndex = 4
                Case 5: .Interior.ColorIndex = 5
                Case 6: .Interior.ColorIndex = 44
                Case "": .Interior.ColorIndex = 0
            End Select
        End With
    Next
    Application.ScreenUpdating = True
End Sub

 

[Roncancio]

Bijna.

                Case [B][COLOR="Red"]"[/COLOR]pietje:[COLOR="Red"]"[/COLOR][/B] .Interior.ColorIndex = 6

Je moet pietje wel tussen aanhalingstekens zetten omdat het tekst is.
Anders gaat de computer zoeken naar de variabele pietje dat er dus niet is.


Met vriendelijke groet,


Roncancio

 

[knarfje]

@Roncancio,

Ik krij een foutmelding als ik "piet" tussen aanhalingtekens zet.(compile error)

 

[Hoornvan]

knarfje,

Ik heb het even getest en moet zeggen het werkt uitstekend.

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.ScreenUpdating = False
    'http://www.mvps.org/dmcritchie/excel/colors.htm'
    Dim cell_in_loop As Range
    For Each cell_in_loop In Range("A1:G10")
        With cell_in_loop
            Select Case .Value
                Case "pietje": .Interior.ColorIndex = 6
                Case 2: .Interior.ColorIndex = 48
                Case 3: .Interior.ColorIndex = 3
                Case 4: .Interior.ColorIndex = 4
                Case 5: .Interior.ColorIndex = 5
                Case 6: .Interior.ColorIndex = 44
                Case "": .Interior.ColorIndex = 0
            End Select
        End With
    Next
    Application.ScreenUpdating = True
End Sub

 

[knarfje]

Hij doet het wel..Perfect!!

 

[Hoornvan]

Vergeet de vraag niet om als opgelost te zetten, dank u

 

[danny147]

Beste knarfje

De reden waarom het niet werkte zal waarschijnlijk aan de reactie gelegen hebben van Roncancio

  Case "pietje[COLOR="Red"][B]:[/B][/COLOR]" .Interior.ColorIndex = 6

De dubbele punt moet achter de aanhalingstekens staan.

zo dus

  Case [COLOR="red"][B]"pietje":[/B][/COLOR] .Interior.ColorIndex = 6

Eind goed al goed het is opgelost :thumb:

Groetjes Danny. :thumb:

 

[Roncancio]

@Danny.
:thumb: Goed gecorrigeerd.

Het belangrijkste is inderdaad dat het probleem is opgelost.

Met vriendelijke groet,


Roncancio

 

[snb]

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.ScreenUpdating = False
    For Each cl In Range("A1:G10")
      with cl.interior
         .colorindex=0
         if cl.Value<>"" Then .colorindex=choose(iif(cl.value="Pietje",1,cl.value),6,48,3,4,5,44)
      end with
    Next
    Application.ScreenUpdating = True
End Sub

of

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.ScreenUpdating = False
    For Each cl In Range("A1:G10")
      cl.interior.colorindex=choose(iif(cl.value="",1,iif(cl.value="Pietje",2,cl.value+1)),0,6,48,3,4,5,44)
    Next
    Application.ScreenUpdating = True
End Sub