vba kleuren

[Roma]

Beste mensen,

Ik heb een code gemaakt in VBA om cellen te kleuren (zie voorbeeld) het grote probleem is dat alle cellen die zijn aangegeven in de macro worden afgelopen naar mijn mening zo'n 3200 keer. Ik heb alles geprobeerd om dit te verhelpen maar ik kom er niet meer uit. De kleuren van de cellen staan op blad 1 met de voorwaarde en het invoerblad is blad 2. wie kan mij helpen.

Ondanks de warmte alvast bedankt.

 

[Roncancio]

Geen reden om alle cellen af te lopen dmv een lus.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo 0
    With Sheets("Blad1").Range("C7:G32")
      Set C = .Find(Target.Value, LookIn:=xlValues, LookAt:=xlWhole)
      ActiveSheet.Unprotect ""
       If C Is Nothing Then Target.Interior.ColorIndex = xlNone: GoTo Z
               Target.Interior.Color = C.Interior.Color
End With
Z: ActiveSheet.Protect ""
End Sub

Zodra een cel wordt gewijzigd, wordt alleen de inhoud van die cel gezocht.
Code kan wel wat korter, maar voor de leesbaarheid heb ik zo weinig mogelijk veranderd.

Met vriendelijke groet,


Roncancio

 

[Roma]

Beste Roncancio,
Je bent een supermens ik heb 2 weken gezocht en gepuzzeld en jij schud het even uit je mouw. Fantastisch bedankt
Ron

 

[Roncancio]

Bedankt voor het compliment
Wat je nog kan doen is de bereiken op het 2e blad benoemen en zo controleren of een cel in die blad is gewijzigd.
Hiermee voorkom je dat de code wordt geactiveerd zodra een willekeurige cel in blad 2 wordt gewijzigd.

Met vriendelijke groet,


Roncancio

 

[Roma]

Beste Roncancio,
Bedankt voor de tip ik ga ermee stoeien al heb ik niet zoveel verstand van VBA maar ik leer, dankzij helpmij, steeds meer.
Heb jij misschien ook een oplossing wanneer iemand een foute code ingeeft de cellen worden geblokkeerd en een waarschuwing krijgt.

 

[huijb]

Verplaatst naar VBA sectie.

 

[Roma]

beste huijb,
wat bedoel je met: Verplaatst naar VBA sectie.

 

[huijb]

Je had de vraag in de Excel sectie geplaatst. Maar je vraag gaat over VBA, dus verplaatst naar genoemde sectie.

 

[Roncancio]

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo 0
    With Sheets("Blad1").Range("C7:G32")
        Set c = .Find(Target.Value, LookIn:=xlValues, LookAt:=xlWhole)
        If Not c Is Nothing Then
            Target.Interior.ColorIndex = c.Interior.ColorIndex
        Else
            Target.Interior.Color = xlNone
            Target.Value = ""
            If c Is Nothing Then MsgBox "Je heeft een ongeldige kleurcode gekozen." & vbNewLine & "Kies een andere kleurcode.", vbExclamation, "Verkeerde kleurcode."
        End If
    End With
End Sub

Het kan wel korter maar zo is het makkelijker te lezen.

Met vriendelijke groet,


Roncancio

 

[Roma]

Roncancio

Bedankt voor je reactie. helaas er zit toch een foutje in, denk ik. Misschien wil je er even naar kijken

 

[Roncancio]

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo 0
    With Sheets("Blad1").Range("C7:G32")
        Set C = .Find(Target.Value, LookIn:=xlValues, LookAt:=xlWhole)
        ActiveSheet.Unprotect ""
        If Not C Is Nothing Then
            Target.Interior.Color = C.Interior.Color
        Else
            Target.Interior.Color = xlNone
            If C Is Nothing Then MsgBox "Je heeft een ongeldige kleurcode gekozen." & vbNewLine & "Kies een andere kleurcode.", vbExclamation, "Verkeerde kleurcode."
            Target.Value = ""
        End If
    End With
    ActiveSheet.Protect ""
End Sub

Ik had de beveiliging er per ongeluk afgehaald.

Met vriendelijke groet,


Roncancio

 

[Roma]

Roncancio,

Wederom je bent geweldig. Bedankt voor alle hulp
Ron

 

[Roma]

Beste Roncancio,

Ik heb geprobeerd om op het 2e blad de bereiken te benoemen maar helaas mijn kennis is nihil kan je mij nog daarmee helpen?
Mijn 2e vraag is kan het in een module gezet worden zodat ik het op 4 tabbladen kan gebruiken.

Ron