verkeerde cel verkleurt hoe kan dat, wat doe ik verkeerd.

[bo69]

De code hieronder werkt goed, maar als ik in cel f12 sta en 26 invul en daarna op de enterknop druk word de cel onder de f12 zwart en niet de cel f12.

Private Sub Worksheet_Change(ByVal Target As Range)
     If Target.Address = "$F$12" And Target = 26 Then
     With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    End If
    If Target.Address = "$F$12" And Target = 3 Then
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End If
    If Target.Address = "$F$12" And Target = 0 Then
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 5287936
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    End If
End Sub

[Janzwart]

Dit komt doordat je nadat je op enter hebt gedrukt cel F13 geselecteerd is. en je zegt in de macro maak de selectie zwart, rood of groen.

Met de volgende code is dat probleem verholpen.

Private Sub Worksheet_Change(ByVal Target As Range)
Range("F12").Select
If Target.Address = "$F$12" And Target = 26 Then
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
If Target.Address = "$F$12" And Target = 3 Then
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
If Target.Address = "$F$12" And Target = 0 Then
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5287936
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
End Sub

[Janzwart]

Bij voorgaande antwoord ga je bij een verandering van het werkblad altijd terug naar cel F12.

Misschien voldoet de volgende code meer aan je wensen.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$F$12" And Target = 26 Then
With Range("F12").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
If Target.Address = "$F$12" And Target = 3 Then
With Range("F12").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
If Target.Address = "$F$12" And Target = 0 Then
With Range("F12").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5287936
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
End Sub

Ik heb selection. Interior vervangen door Range("F12").Interior.

[bo69]

bedankt voor de snelle reactie het werkt perfect

[bo69]

ik heb mijn vel beveiligt hoe werkt dit als ik dit achter een sheet plak met de code van boven in.

ActiveSheet.Unprotect Password:="bo1222"



 ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="bo1222"

[Janzwart]

Door de code zo te plaatsen haalt hij na een verandering op het werkblad de beveiliging eraf en beveiligd hem op het eind van de macro ook weer.

Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect Password:="bo1222"
If Target.Address = "$F$12" And Target = 26 Then
With Range("F12").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
If Target.Address = "$F$12" And Target = 3 Then
With Range("F12").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
If Target.Address = "$F$12" And Target = 0 Then
With Range("F12").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5287936
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="bo1222"
End Sub

[Warme bakkertje]

Zo lukt het ook

Private Sub Worksheet_Change(ByVal Target As Range)
     If Target.Address = "$F$12" Then
     ActiveSheet.Unprotect Password:="bo1222"
     With Target
        Select Case .Value
            Case 26
                nColor = 1
            Case 3
                nColor = 2
            Case 0
                nColor = 3
        End Select
    .Interior.Color = Choose(nColor, 2, 255, 5287936)
    End With
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="bo1222"
    End If
End Sub

[snb]

Als het werkblad is beveiligd kan er toch ook niets in cel F12 gewijzigd worden ? Dan kan deze code toch niet uitgevoerd worden ?

Zo kan het ook in een onbeveiligd werkblad: (vergelijk eens met de omvang van de eerste code die je plaatste)

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$F$12" Then Target.Interior.Color = Choose(Application.Match(Target, Array(0,3,26), 0),5287936,255,2)
End Sub

of

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$F$12" Then Target.Interior.Color = Switch(Target = 0,5287936,Target = 3, 255,Target = 26, 2)
End Sub

@Jan: beveiligt

[bo69]

waar moet ik schrijven of klikken dat het opgelost is en waar kan ik weer een nieuwe vraag stellen.