zoek en vind uitdaging

[ewezel]

Beste Helpers,

Ben afgelopen week prima geholpen met een stukje code hier op dit forum.

Kamp nu met nog een uitdaging met hetzelfde bestand.

Graag zou ik op het werblad planningsweergave een sel gekleurd zien bij de juiste naam.maand en dag.
De gegevens staan op het werkblad aanvraag.

alvast bedankt voor het meedenken.

 

[Niels28]

Aangezien je macro niet werkt in je voorbeeld,
een macro voor alleen het inkleuren.

Sub Planning()

For Each cl In Sheets("aanvraag").Range("a3:a30").SpecialCells(2)
With Sheets("planningsweergave").Range("A" & (Month(cl.Offset(0, 1).Value) - 1) * 27 + 8).Resize(23, 1)
Set c = .Find(cl.Value)
c.Offset(0, Day(cl.Offset(0, 1).Value) + 7 - Day(Sheets("planningsweergave").Cells((Month(cl.Offset(0, 1).Value) - 1) * 27 + 7, 8).Value)).Interior.Color = vbRed
End With
Next

End Sub

Niels

 

[ewezel]

Hoi Niels,

Hartelijk dank voor je reactie.
Heb nog een kleine vraag, je code werkt perfect alleen zou ik graag willen dat de rij waarvan de eerste cel actief verwerkt wordt op het planningsweergaveblad er kunnen namelijk ook aanvragen worden afgekeurd.
Dit is een stukje uit een grotere werkmap.

zou je hier nog een keer naar kunnen kijken.

alvast bedankt

 

[Niels28]

Lees je eigen vraag eens terug met de gedachte dat iemand anders niet weet waar je het over hebt.

Niels

 

[ewezel]

sorry Niels inderdaad is niet heel duidelijk wat ik bedoel.

probeer het opnieuw

Op het blad aanvraag wordt de cel geselecteerd met de naam van de aanvrager.
Daarna zou de code alleen die rij moeten verwerken op het blad planningsweergave, dus niet heel kolom a op het blad aanvraag.

Hoop dat het zo iets duidelijker wordt voor je.

groeten erwin

 

[Niels28]

Dat kan, maar is de macro dan nog wel zinvol?
hoeveel regels zet je om.
ipv per regel de macro knop in te duwen kun je dan net zo goed de cel rood kleuren.

Het kan ook allemaal in eens als je een kolom toevoegd met daar in aangegeven of hij overgenomen moet worden.

bv als je in kolom H een j zet wordt deze overgenomen.

Sub Planning()

For Each cl In Sheets("aanvraag").Range("a3:a30").SpecialCells(2)
If UCase(cl.Offset(0, 7).Value) = "J" Then
With Sheets("planningsweergave").Range("A" & (Month(cl.Offset(0, 1).Value) - 1) * 27 + 8).Resize(23, 1)
Set c = .Find(cl.Value)
c.Offset(0, Day(cl.Offset(0, 1).Value) + 7 - Day(Sheets("planningsweergave").Cells((Month(cl.Offset(0, 1).Value) - 1) * 27 + 7, 8).Value)).Interior.Color = vbRed
End With
End If
Next
End Sub

Niels

 

[ewezel]

Hoi Niels,

Ongeveer 5 a 10 gemiddeld per week.
Op het origineel zit namelijk nog een cmd button met niet akkoord.

kan het originele bestand wel voor je posten moet dan alleen even wat info eruit filteren.

met vriendelijk groet erwin

 

[Niels28]

zo is ie alleen voor de activecell

Sub Planning()
If Intersect(ActiveCell, Range("$A$3:$A$30")) Is Nothing Then Exit Sub
With Sheets("planningsweergave").Range("A" & (Month(ActiveCell.Offset(0, 1).Value) - 1) * 27 + 8).Resize(23, 1)
Set c = .Find(ActiveCell.Value)
c.Offset(0, Day(ActiveCell.Offset(0, 1).Value) + 7 - Day(Sheets("planningsweergave").Cells((Month(ActiveCell.Offset(0, 1).Value) - 1) * 27 + 7, 8).Value)).Interior.Color = vbRed
End With
End Sub

Niels

 

[ewezel]

Hoi Niels

ga er vanavond even mee stoeien, kijken of ik het kan begrijpen wat deze code precies doet, zodat ik deze in mijn origineel kan toepassen.

alvast bedankt

 

[ewezel]

hé Niels,

werkt perfect :thumb:

mijn bestand is helemaal klaar nu.

vriendelijk bedankt voor de hulp