Macro zodat de celkleur wordt aangepast

Status
Niet open voor verdere reacties.
N

NPersijn

Gebruiker
Lid geworden
27 jul 2018
Berichten
56
Beste,

Dank dat ik lid mag zijn van dit forum.
Dit is mijn eerste vraag.

Ik heb een personeelsplanning gemaakt.
Hierin staan vaste FTE en mensen van uitzendbureaus
Nu wil ik graag een macro dat de kleur van de cel blauw wordt als een persoon van het uitzendbureau op de betreffende cel staat genoteerd.
In een tabel staat in de cel achter de naam A, B of TT.
Wanneer in de cel TT staat moet de cel blauw kleuren.
Hoe kan ik dit doen?
In de bijlage heb ik m'n file toegevoegd.
Vast bedankt

Met vriendelijke groet
 
Laatst bewerkt:
Welkom op het forum.

1. VBA en samengevoegde cellen gaat problemen opleveren
2. Zijn deze gegevens wel fictief? Zo komt het niet op mij over.
 
SjonR zei:
Welkom op het forum.

1. VBA en samengevoegde cellen gaat problemen opleveren
2. Zijn deze gegevens wel fictief? Zo komt het niet op mij over.
Klik om te vergroten...

Beste SjonR

1. VBA en samengevoegde cellen. Ik heb een exemplaar gezien waar dat wel mogelijk is alleen weet niet hoe.
De volgende macro heb ik daarin gezien.

Sub A_nw_TT_namen()
'TT namen kolom maken
Sheets("PERSONEEL").Select
TELLER2 = 6
TELLER3 = 31
Range("l31:l108").ClearContents

Do While TELLER2 < 180


If Range("g" & TELLER2).Value = "TT" Then
Range("f" & TELLER2).Copy
Range("l" & TELLER3).FormulaR1C1 = Range("f" & TELLER2).Value

TELLER3 = TELLER3 + 1
End If

TELLER2 = TELLER2 + 1
Loop

2. De gegevens zijn inmiddels fictief. Bedankt voor de tip
 
Laatst bewerkt:
Ik zeg ook niet dat het onmogelijk is:

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Sheets("rooster").Range("C9:AF50")) Is Nothing Then
    If Sheets("data").Columns(1).Find(Target).Offset(, 2).Value = "TT" Then
        Target.Interior.Color = vbBlue
    Else
        Target.Interior.Color = xlNone
    End If
End If
End Sub
 
Je behoeft het blad niet te benoemen in de code waar de code staat.
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C9:AF50")) Is Nothing Then
    Target.Interior.Color = IIf(Sheets("data").Columns(1).Find(Target).Offset(, 2).Value = "TT", vbBlue, xlNone)
  End If
End Sub

En zet:
Code: 
Application.EnableEvents = False
en...
Code: 
Application.EnableEvents = true

..bij in je selection_change code.
 
Laatst bewerkt:
Het hoeft niet, maar het kan... en maakt bovendien geen verschil tijdens het uitvoeren, maar je kritische blik wordt altijd gewaardeerd :thumb:
 
Dat komt door je selection_change event.
Mijn suggestie toepassen in mijn vorig schrijven.

PS. Ik heb die code verder niet bekeken.
Selection_changes zijn meestal nergens goed voor, of je moet een bepaald bereik opgeven zodat het allemaal wat vlotter gaat.
 
Laatst bewerkt:
Er staan een aantal onnodige zaken in onderstaande code, en misschien zie ik nog wel iets over het hoofd.

Ook zijn er betere validatieformules met verschuiving.


Het rode is overbodig, blauw moet je toevoegen\veranderen.
Maak ook inspringpunten in de codes voor de leesbaarheid.
Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect(Target, [COLOR=#ff0000]Sheets("rooster").[/COLOR]UsedRange) Is Nothing And Target.Count = 2 And[COLOR=#ff0000] Sheets("rooster").[/COLOR]Cells(1, Target.Column).Value <> "" Then
     [COLOR=#0000ff]Application.EnableEvents = False[/COLOR]
         If [COLOR=#ff0000]Sheets("rooster").[/COLOR]Cells(1, Target.Column).Value = "o" Then
             [COLOR=#ff0000]'Sheet1.Range(Sheet1.Cells(1, 70).Address, Sheet1.Cells(1000000, 70).Address) = ""  [/COLOR] 
             [COLOR=#0000ff]columns(70).clearcontents[/COLOR][COLOR=#ff0000][/COLOR]
                  ins = Sheet2.UsedRange.Value
                     For y = 2 To UBound(ins, 2)
                        If ins(1, y) = [COLOR=#ff0000]Sheet1.[/COLOR]Cells(Target.Row, 1) Then
                               Z = 1
                                    For x = 2 To UBound(ins[COLOR=#ff0000], 1[/COLOR])
                                       If ins(x, y) <> "" Then
                                           Z = Z + 1
                                         [COLOR=#ff0000]Sheet1.[/COLOR]Cells(Z, 70) = ins(x, y)
                                       End If
                                    Next x
                               [COLOR="#FF0000"]'Goto uit[/COLOR]
                              [COLOR="#0000FF"]exit for[/COLOR]
                           End If
                     Next y
[COLOR="#FF0000"]'uit:[/COLOR]
End If
[COLOR=#0000ff]Application.EnableEvents = True[/COLOR]
End If
End Sub
 
Laatst bewerkt:
waardering

HSV zei:
Er staan een aantal onnodige zaken in onderstaande code, en misschien zie ik nog wel iets over het hoofd.

Ook zijn er betere validatieformules met verschuiving.[/CODE]
Klik om te vergroten...

Na een week ziek te zijn weer terug.
Ik heb eea aangepast zoals aangegeven. Het werkt wel maar kan niet zeggen dat het sneller geworden is.
Bij selection change moest ik wat veranderen. Waar kan ik dit vinden?

Gr Norman
 
In de module van blad 'Rooster'.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan