Planningsbestand

[toverkamp]

Hallo mensen,

Ik ben bezig met het maken van een planningsbestand voor projecten. Ik heb een invoerblad gemaakt waar alle projecten ingevoerd worden.
In een ander werblad moet een grafische weergave (gekleurde cellen) komen van de geplande projecten op datum bij de juiste persoon.

Om het geheel te verduidelijken heb ik een bestand bijgevoegd. Als het niet duidelijk genoeg is hoor ik het graag!

 

[danny147]

Beste toverkamp

Heb al een stapje in de goede richting gevonden.
Enkel voor het tweede, derde en vierde kwartaal lukt het mij niet.
Hij houdt steeds rekeneing met de eerste piet, Jan, ...

Er zijn op dit forum wel een paar excelspecialisten die dit wel kunnen oplossen.

Groetjes Danny. :thumb:

 

[toverkamp]

Beste toverkamp

Heb al een stapje in de goede richting gevonden.
Enkel voor het tweede, derde en vierde kwartaal lukt het mij niet.
Hij houdt steeds rekeneing met de eerste piet, Jan, ...

Er zijn op dit forum wel een paar excelspecialisten die dit wel kunnen oplossen.

Groetjes Danny. :thumb:

Hallo Danny,

Allereerst hartelijk dank voor uw reactie. Dit is echter nog niet wat ik helemaal zoek.

Het is namelijk mogelijk dat er per persoon meerder projecten per kwartaal worden uitgevoerd. Dus kunnen er ook meerdere vakken in 1 rij gekleurd worden. Vanuit het eerste werkblad moet het tweede werkblad als het ware worden ingevuld.

In de bijlage heb ik een voorbeeld geplaatst hoe het er uit kan komen te zien.

 

[Wigi]

Sub wigi()

    Dim r As Range
    Dim rFoundCell As Range
    
    For Each r In Sheets("Invoer").Range("A9:A12")
    
        Set rFoundCell = Sheets("Planning2").Range("A4:A8").Find(what:=r.Value, LookIn:=xlValues, lookat:=xlWhole)
        
        With rFoundCell
            .Offset(, r.Offset(, 2).Value - DateSerial(2007, 1, 1) + 1).Resize(, r.Offset(, 3).Value + 1).Interior.ColorIndex = 15
            .Offset(, r.Offset(, 5).Value - DateSerial(2007, 1, 1) + 1).Interior.ColorIndex = 3
        End With
    
    Next

End Sub

Wigi

 

[toverkamp]

Sub wigi()

    Dim r As Range
    Dim rFoundCell As Range
    
    For Each r In Sheets("Invoer").Range("A9:A12")
    
        Set rFoundCell = Sheets("Planning2").Range("A4:A8").Find(what:=r.Value, LookIn:=xlValues, lookat:=xlWhole)
        
        With rFoundCell
            .Offset(, r.Offset(, 2).Value - DateSerial(2007, 1, 1) + 1).Resize(, r.Offset(, 3).Value + 1).Interior.ColorIndex = 15
            .Offset(, r.Offset(, 5).Value - DateSerial(2007, 1, 1) + 1).Interior.ColorIndex = 3
        End With
    
    Next

End Sub

Wigi

Supermooie code wigi!!
Ik heb alleen nog een vraag. In deze code staat het gedeelte:

For Each r In Sheets("Invoer").Range("A9:A12")

ik wil deze range echter uitbreiden naar bijvoorbeeld A9:A500 , dit werkt echter niet omdat de rijen onder A12 niet gevuld zijn en daarom een foutmelding geeft. Weet je misschien hoe ik dit kan oplossen?

Superbedankt alvast!

 

[Wigi]

Sub wigi()

    Dim r As Range
    Dim rFoundCell As Range
    
    For Each r In Sheets("Invoer").Range("A9:A12")
    
[B]        If r.Value <> "" Then[/B]

        Set rFoundCell = Sheets("Planning2").Range("A4:A8").Find(what:=r.Value, LookIn:=xlValues, lookat:=xlWhole)
        
        With rFoundCell
            .Offset(, r.Offset(, 2).Value - DateSerial(2007, 1, 1) + 1).Resize(, r.Offset(, 3).Value + 1).Interior.ColorIndex = 15
            .Offset(, r.Offset(, 5).Value - DateSerial(2007, 1, 1) + 1).Interior.ColorIndex = 3
        End With

[B]        End If[/B]
    
    Next

End Sub

 

[toverkamp]

Wigi superbedankg
werkt super:thumb:

 

[toverkamp]

Ik heb nog een vraag met betrekking tot het planningsbestand:

Wat ik tot nu toe heb werkt prima! Met dank aan Wigi
De rijen die ingevoerd worden zijn echter alleen voor het 1e kwartaal. Ik heb daaronder de andere 3 kwartalen van het jaar ook toegevoegd. Wanneer ik nu een project wil inplannen moet deze op de juiste kolom bij het juiste kwartaal worden ingevoerd.

Ik heb de code van Wigi al wat aangepast voor het tweede kwartaal:

    Dim r As Range
    Dim rFoundCell As Range
    
    For Each r In Sheets("Invoer").Range("A9:A500")
    
        If r.Value <> "" Then

        Set rFoundCell = Sheets("Planning2").Range("[B][COLOR="Red"]A12:A16[/COLOR][/B]").Find(what:=r.Value, LookIn:=xlValues, lookat:=xlWhole)
        
        With rFoundCell
            .Offset(, r.Offset(, 2).Value - DateSerial(2007, 1, 1) + 1).Resize(, r.Offset(, 3).Value + 1).Interior.ColorIndex = 15
            .Offset(, r.Offset(, 5).Value - DateSerial(2007, 1, 1) + 1).Interior.ColorIndex = 3
        End With
        End If
    Next

Het probleem is nu echter dat het project dubbel wordt ingepland, zowel bij kwartaal 1 als bij kwartaal 2. Weet iemand (wigi?) hoe ik de code zo kan aanpassen het project bij het juiste kwartaal wordt ingevoerd?

Zie bijlage

 

[toverkamp]

Hallo mensen,

Ik heb mijn planningsbestand enigzins aangepast, maar mijn probleem is nog steeds gebleven. Wat is namelijk het geval:

Met Wigi's code wordt een project op de juiste data ingepland. Ik het het jaar in 4 kwartalen verdeeld. Wanneer ik deze code van Wigi ook zou toepassen (aanpassen) voor het tweede kwartaal en een project voor het tweede kwartaal invoer, wordt deze echter dubbel ingevoerd, namelijk ook in kwartaal 1. Weet iemand hoe de code moet worden aangepast zodat het project automatisch in de juiste kwartaal wordt gezet.

Zie de bijlage voor de duidelijkheid en de code.

 

[toverkamp]

Ik ben nog even bezig geweest met het planningsbestand. Ik heb de 4 kwartalen vervangen door 2 halfjaren. De volgende code zorgt ervoor dat de juiste cellen worden ingekleurd op het werkblad "Planning2":

    Dim r As Range
    Dim rFoundCell As Range
    
    For Each r In Sheets("Invoer").Range("A9:A500")
    
        If r.Value <> "" Then

        Set rFoundCell = Sheets("Planning2").Range("A4:A8").Find(what:=r.Value, LookIn:=xlValues, lookat:=xlWhole)
        
        With rFoundCell
            .Offset(, r.Offset(, 2).Value - DateSerial(2007, 1, 1) + 1).Resize(, r.Offset(, 9).Value + 1).Interior.ColorIndex = 15
            .Offset(, r.Offset(, 5).Value - DateSerial(2007, 1, 1) + 1).Interior.ColorIndex = 3
        End With
        End If
        
    Next

Nu wil ik deze code aanpassen dat wanneer een project in het 2e halfjaar valt, dat de cellen in de juiste rij worden gekleurd. Ik heb dat als volgt gedaan, maar dit werkt dus niet:

    Dim a As Range
    Dim [COLOR="Red"]a[/COLOR]FoundCell As Range
    
    For Each [COLOR="red"]a[/COLOR] In Sheets("Invoer").Range("A9:A500")
    
        If [COLOR="red"]a[/COLOR].Value <> "" Then

        Set aFoundCell = Sheets("Planning2").Range("[COLOR="red"]A12:A16[/COLOR]").Find(what:=[COLOR="red"]a[/COLOR].Value, LookIn:=xlValues, lookat:=xlWhole)
        
        With rFoundCell
            .Offset(,[COLOR="red"] a[/COLOR].Offset(, 2).Value - DateSerial(2007, 1, 1) + 1).Resize(, [COLOR="red"]a[/COLOR].Offset(, 9).Value + 1).Interior.ColorIndex = 15
            .Offset(, [COLOR="red"]a[/COLOR].Offset(, 5).Value - DateSerial(2007, 1, 1) + 1).Interior.ColorIndex = 3
        End With
        End If
        
    Next

 

[Finch]

Ik heb eens even naar je sheet gekeken. Ik heb nog niet de tijd gehad om de code ivm de planning te bekijken.
Maar wat me opvalt is dat er nog heel wat schoonheidsfoutjes zitten in je sheet die mogelijk ook een invloed hebben op het al dan niet correct uitvoeren van uw code.

Kolom E op het tabblad "invoer" geeft geen correcte waarde weer. Dat komt omdat de datum vanwaar je vertrekt niet correct is ingevuld voor de formule. Je ziet hem wel correct staan in je sheet, maar eigenlijk is je datum een tekst die opgemaakt met een datumnotatie. De werkdagfunctie heeft hier vaak problemen mee. Het is aangeraden die begindatum te definieren met Datum(jaar;maand;dag). Dit zal waarschijnlijk ook een invloed hebben op de code om je comboboxen uit te lezen.

Een ander punt dat me opvalt is het wanneer je userform (FormPlan) wordt geladen, je standaard voor de deadline een datum kiest die 5 dagen na de huidige dag ligt. Dat op zich kan geen kwaad, maar de manier waarop je dit doet is niet helemaal correct. Je neemt nu de huidige dag en telt daar gewoon 5 bij op. Maar vandaag betekent dat concreet dat je 29+5 doet. Wat 34 als resultaat geeft, en dat schrijf je ook weg in je sheet, met als gevolg een niet geldige invoer. Je kan dit bijvoorbeeld oplossen op onderstaande manier:

[FONT="Courier New"]Deadlinedatum = DateAdd("d", 5, Date) '5 dagen bij vandaag verder tellen

dagnu = Day(Deadlinedatum)
maandnu = Month(Deadlinedatum)
jaarnu = Year(Deadlinedatum)

FormPlan.CmbDeadDag.Value = dagnu
FormPlan.CmbDeadMaand.Value = maandnu
FormPlan.CmbDeadJaar.Value = jaarnu[/FONT]

Dit kan ook nog iets korter geschreven worden, maar dat doet er eigenlijk niet toe.

Dat zijn zo twee fouten die er dadelijk uitsprongen bij mij, en, niet met kwetsende bedoelingen, maar zo zullen er nog meer in staan. En dan denk ik voornamelijk voor het wegschrijven van datums. Je schrijft ze nu weg op volgende manier dacht ik: dag-maand-jaar, en dan geef je ze de gewenste opmaak in je code, maar op die manier werk je, zonder het te willen waarschijnlijk, met strings ipv met datums.
Het is ook aangeraden om al je variabelen op voorhand te definiëren, dan kan je vaak al heel wat (onbedoelde) fouten uitsluiten of makkelijk opsporen en oplossen.

Kijk anders eerst eens kritisch naar al je invoer (code en datatypes), misschien dat jouw aanpassing aan de code van Wigi dat wel werkt. Moest je nog met vragen zitten stel ze hier dan gerust, er is altijd wel iemand die je zal proberen te helpen.

 

[toverkamp]

Kolom E op het tabblad "invoer" geeft geen correcte waarde weer. Dat komt omdat de datum vanwaar je vertrekt niet correct is ingevuld voor de formule. Je ziet hem wel correct staan in je sheet, maar eigenlijk is je datum een tekst die opgemaakt met een datumnotatie. De werkdagfunctie heeft hier vaak problemen mee. Het is aangeraden die begindatum te definieren met Datum(jaar;maand;dag). Dit zal waarschijnlijk ook een invloed hebben op de code om je comboboxen uit te lezen.


Dat zijn zo twee fouten die er dadelijk uitsprongen bij mij, en, niet met kwetsende bedoelingen, maar zo zullen er nog meer in staan. En dan denk ik voornamelijk voor het wegschrijven van datums. Je schrijft ze nu weg op volgende manier dacht ik: dag-maand-jaar, en dan geef je ze de gewenste opmaak in je code, maar op die manier werk je, zonder het te willen waarschijnlijk, met strings ipv met datums.
Het is ook aangeraden om al je variabelen op voorhand te definiëren, dan kan je vaak al heel wat (onbedoelde) fouten uitsluiten of makkelijk opsporen en oplossen.

Finch,
allereerst hartelijk dank voor je tips!

Voor de datumnotatie heb ik in het userform de volgende code staan:

'zorg voor de juiste datumnotatie
startdatum = Format(startdatum, "mm-dd-yy")
deadline = Format(deadline, "mm-dd-yy")

Ik heb deze format gekozen, omdat wanneer ik dit niet zou doen, dan zou Excel 1-2-07 veranderen in 2-1-07. In kolom E heb ik de opmaak op aangepast staan, zodat ik ook kan zien wat voor dag bijvoorbeeld 1-2-07 is.

Het tweede punt bij deadline + 5 dagen heb ik nu ook aangepast. De code die je me gaf werkt prima! Ik kwam er zelf ook net achter dat ik dan op 34 uitkwam (voor vandaag). Vorige week had ik dat namelijk nog niet door dat hij er gewoon 5 bij bovenop zou tellen.

Het probleem voor het invoeren van het 2e halfjaar is echter nog niet opgelost..

Alvast hartelijk dank:thumb:

 

[Finch]

Ik begrijp je werkwijze ivm die datumnotitie, maar eigenlijk is deze niet correct. Voor een correcte werking met datumformules moet je datum een datum zijn en geen string opgemaakt als datum.

Probeer (test) onderstaande code maar eens (Deadline kan je analoog benanderen).

Dim startdatum as date
startdatum = DateSerial(CmbStartJaar, CmbStartMaand, CmbStartDag)

 

[toverkamp]

Finch,

Ik heb de code aangepast. Hopelijk heb ik de foutjes er nu uitgehaald! Erg bedankt voor het meedenken

Ik hoop dat iemand mij nog kan helpen met het invoeren van het 2e halfjaar, want dat lukt immers nog steeds niet Ik heb hier het nieuwste bestand bij toegevoegd.

 

[Finch]

Hallo Toverkamp,

Even kijkend naar de code heb ik gemerkt dat je de code voor de startdatum hebt gewijzigd, maar niet voor de deadline datum. Deze kan je best op dezelfde manier veranderen.

Wat me verder nog opvalt is dat de het planningsoverzicht nu werkt met semesters ipv kwartalen? Is daar een speciale reden voor? Want dat verandert uiteraard de code voor het vervolledigen van deze planning.
Ik stel me wel nog vragen bij de schaalbaarheid van deze planningssheet. Wat gebeurt er wanneer er meer mensen bijkomen? Die mogelijkheid laat je open in je waardes van de tab "codes_overzicht", maar binnen je planningssheet heb je weinig werkruimte, je gaat dan rijen moeten bijvoegen en dat gaat gevolgen hebben voor je code. Een mogelijkheid bestaat erin evenveel rijen per periode (kwartaal of semester) te tonen, en enkel die rijen te tonen waar een persoon is ingevuld, en de rest gewoon te verbergen. Je geeft enkel maar een overzicht voor 2007, wat indien een project in 2008 loopt? Niet weergeven, anders weergeven, nieuw bestand? Allemaal keuzes.
Het is beter dat je ook over die zaken nadenkt, want schaalbaarheid wordt dikwijls onderschat, maar is imo toch belangrijk.

Ik heb ook gekeken waarom je aanpassing niet lukte. Eigenlijk is dat vrij eenvoudig. Je moet een check doen om te zien in welk gedeelte (welke periode) je cellen moet gaan kleuren. Het is daarom belangrijk van een keuze te maken om te werken met kwartalen of semesters. Beide kunnen hoor, maar dan moet je in je code aangeven of je nu wilt werken met kwartalen of semesters.
Omdat ik geloof dat zaken die jezelf uitvogelt vaak langer blijven hangen, dan kant-en-klare oplossingen ga ik je niet dadelijk de code geven om alles te doen werken, maar je op weg helpen zodat je zelf kan aanpassen, en wanneer je er dan niet uitgeraakt helpen we je natuurlijk verder.

Manier van werken:
* Op basis van de datum in kolom C in de tab "invoer" (=startdatum), ga je moeten kijken in welke periode (uitkomst afhankelijk van keuze semester/kwartaal) je zit. Hierbij ook rekening houden met het jaartal, een project in 2008 kan je niet correct weergeven worden in een planningsoverzicht van 2007.

* Dan moet je voor die periode de juist range op sheet "planning 2" gebruiken om de data correct te zetten.

* In de code van Wigi moet je de constructie

[FONT="Courier New"]- DateSerial(2007, 1, 1)[/FONT]

vervangen door de begindatum van elke periode (ook weer afhankelijk van keuze kwartaal, semester).
Om het volledig te maken moet je ook kijken in welke periode je einddatum ligt, want soms is dat in overlopende periodes.

Je werkt hier enkel met een plannning op jaarniveau dat heeft consequenties. Wat ga je bv. doen als een project niet volledig binnen één jaar valt (bv. van dec 2007 tot jan 2008)?
Je kan 3 jaartallen kiezen in je userform maar voorlopig kan je enkel die van 2007 correct weergeven (zie ook infra).

Je ziet het ik heb nog heel wat opmerkingen bij je opzet, maar ik heb er alle vertrouwen in, dat je dit tot een goed einde kan brengen.

 

[toverkamp]

Ik werk inderdaad nu met halfjaren, omdat ik dat wat overzichtelijker vond staan. Daarnaast kunnen er niet meer mensen bijkomen, dus die optie hoeft niet toegevoegd te worden. Ik heb nu het jaar 2008 ook toegevoed (in halfjaren) en de code ook aangepast aan de begindatum van het volgend halfjaar.

De code die ik nu voor 2007 heb (beide halfjaren) is:

    Dim r As Range
    Dim a As Range
    
    Dim rFoundCell As Range
    Dim aFoundCell As Range
    
    For Each r In Sheets("Invoer").Range("A9:A500")
    For Each a In Sheets("Invoer").Range("A9:A500")
    
        If r.Value <> "" Then
        If a.Value <> "" Then

        Set rFoundCell = Sheets("Planning2").Range("A4:A8").Find(what:=r.Value, LookIn:=xlValues, lookat:=xlWhole)
        Set aFoundCell = Sheets("Planning2").Range("A12:A16").Find(what:=a.Value, LookIn:=xlValues, lookat:=xlWhole)
        
        With rFoundCell
        With aFoundCell
        
            .Offset(, r.Offset(, 2).Value - DateSerial(2007, 1, 1) + 1).Resize(, r.Offset(, 9).Value + 1).Interior.ColorIndex = 15
            [COLOR="Red"].Offset(, a.Offset(, 2).Value - DateSerial(2007, 7, 1) + 1).Resize(, a.Offset(, 9).Value + 1).Interior.ColorIndex = 15[/COLOR]            
            .Offset(, r.Offset(, 5).Value - DateSerial(2007, 1, 1) + 1).Interior.ColorIndex = 3
            .Offset(, a.Offset(, 5).Value - DateSerial(2007, 7, 1) + 1).Interior.ColorIndex = 3
        
        End With
        End With
        
        End If
        End If
        
    Next
    Next

Bij het rode gedeelte geeft hij echter een fout: Door de toepassing of door object gedefinieerde fout. Kun je me uitleggen wat ik hier fout doe?

Alvast bedankt!!

 

[Finch]

Ik werk inderdaad nu met halfjaren, omdat ik dat wat overzichtelijker vond staan. Daarnaast kunnen er niet meer mensen bijkomen, dus die optie hoeft niet toegevoegd te worden. Ik heb nu het jaar 2008 ook toegevoed (in halfjaren) en de code ook aangepast aan de begindatum van het volgend halfjaar.

De code die ik nu voor 2007 heb (beide halfjaren) is:

    Dim r As Range
    Dim a As Range
    
    Dim rFoundCell As Range
    Dim aFoundCell As Range
    
    For Each r In Sheets("Invoer").Range("A9:A500")
    For Each a In Sheets("Invoer").Range("A9:A500")
    
        If r.Value <> "" Then
        If a.Value <> "" Then

        Set rFoundCell = Sheets("Planning2").Range("A4:A8").Find(what:=r.Value, LookIn:=xlValues, lookat:=xlWhole)
        Set aFoundCell = Sheets("Planning2").Range("A12:A16").Find(what:=a.Value, LookIn:=xlValues, lookat:=xlWhole)
        
        With rFoundCell
        With aFoundCell
        
            .Offset(, r.Offset(, 2).Value - DateSerial(2007, 1, 1) + 1).Resize(, r.Offset(, 9).Value + 1).Interior.ColorIndex = 15
            [COLOR="Red"].Offset(, a.Offset(, 2).Value - DateSerial(2007, 7, 1) + 1).Resize(, a.Offset(, 9).Value + 1).Interior.ColorIndex = 15[/COLOR]            
            .Offset(, r.Offset(, 5).Value - DateSerial(2007, 1, 1) + 1).Interior.ColorIndex = 3
            .Offset(, a.Offset(, 5).Value - DateSerial(2007, 7, 1) + 1).Interior.ColorIndex = 3
        
        End With
        End With
        
        End If
        End If
        
    Next
    Next

Bij het rode gedeelte geeft hij echter een fout: Door de toepassing of door object gedefinieerde fout. Kun je me uitleggen wat ik hier fout doe?

Alvast bedankt!!

Ik zal eerst zeggen waarom het fout loopt. In die rode regel ga je een bepaalde cel (=combinatie rij en kolom) kleuren. De rij ligt al vast, maar je moet nog zoeken naar de kolom waar te beginnen. Daarvoor bereken je gewoon het aantal dagen tussen 1/1/2007 en de startdatum. En gaat dan zoveel kolommen verder een eerste maal kleuren en dit voor zoveel kolommen als de duur van het project.
Het probleem nu is eigenlijk dat er meer dagen liggen tussen 1/1/2007 en de startdatum dan dat er kolommen beschikbaar zijn in Excel. Je probeert hem dus te wijzen naar een kolom die binnen Excel niet bestaat en vandaar die fout.

Nu weet je waarom hij daar een foutmelding geeft, maar nu hem nog oplossen.

Je nieuwe opzet is goed bedoeld, maar niet helemaal correct. Je dient te werken met een if then else structuur (alternatief case structuur).

In pseudocode voor de handelingen per rij.

Bepaal Semeseter startdatum
Bepaal Semester einddatum

IF semester startdatum = semester einddatum THEN
     IF semester=1 THEN
          kleurcellen in gebied tussen rij 4 en 8
     ELSEIF semester = 2 THEN
          kleurcellen in gebied tussen rij 12 en 16
     END IF
ELSE
     IF semster startdatum = 1 THEN
          Kleurcellen in gebied tussen rij 4 en 8 tot einde semester
          Kleurcellen in gebied tussen rij 12 en 16 vanaf eerste dag semester tot einddatum
     ELSEIF semester startdatum=2 then
          Kleurcellen in gebied tussen rij 12 en 16 tot einde semester
          Kleurcellen in gebied tussen rij 4 en 8 vanaf eerste dag semester tot einddatum (in het volgend jaar)
     END IF
END IF

Jouw probleem was in feite dat hij altijd alle code ging uitvoeren, door een IF THEN ELSE structuur bepaal je eigenlijk welk deel van de code je wil uitvoeren en op welk moment.

Ik hoop dat het een beetje duidelijk is op die manier, anders moet je zeker verder doorvragen tot je je antwoorden hebt.

 

[toverkamp]

Oké, ik snap de nieuwe structuur nu een beetje. Ik had het volgende bedacht:

    Dim r As Range
    Dim a As Range
    
    Dim rFoundCell As Range
    Dim aFoundCell As Range
    
    For Each r In Sheets("Invoer").Range("A9:A500")
    For Each a In Sheets("Invoer").Range("A9:A500")
    
        [COLOR="Blue"]If [/COLOR]r.Value <> "" [COLOR="blue"]Then[/COLOR]
        Set rFoundCell = Sheets("Planning2").Range("A4:A8").Find(what:=r.Value, LookIn:=xlValues, lookat:=xlWhole)
        
        [COLOR="blue"]Else[/COLOR]
        
        [COLOR="blue"]If [/COLOR]a.Value <> "" [COLOR="blue"]Then[/COLOR]
        Set aFoundCell = Sheets("Planning2").Range("A12:A16").Find(what:=a.Value, LookIn:=xlValues, lookat:=xlWhole)
        
        End If

[COLOR="Red"]-------------------------------------------------------------------------------------------------------------      [/COLOR]          
        With rFoundCell
        
        .Offset(, r.Offset(, 2).Value - DateSerial(2007, 1, 1) + 1).Resize(, r.Offset(, 9).Value + 1).Interior.ColorIndex = 15
        .Offset(, r.Offset(, 5).Value - DateSerial(2007, 1, 1) + 1).Interior.ColorIndex = 3
                
        
        With aFoundCell
        
        .Offset(, a.Offset(, 2).Value - DateSerial(2007, 7, 1) + 1).Resize(, a.Offset(, 9).Value + 1).Interior.ColorIndex = 15
        .Offset(, a.Offset(, 5).Value - DateSerial(2007, 7, 1) + 1).Interior.ColorIndex = 3
        
        
        End With

Het bovenste gedeelte klopt volgens mij wel redelijk, maar dat weet ik niet zeker. Maar onder de rode streep weet ik niet hoe het verder moet. Misschien kun je me (nog) een duwtje in de goede richting geven!

 

[Finch]

Oké, ik snap de nieuwe structuur nu een beetje. Ik had het volgende bedacht:

    Dim r As Range
    Dim a As Range
    
    Dim rFoundCell As Range
    Dim aFoundCell As Range
    
    For Each r In Sheets("Invoer").Range("A9:A500")
    For Each a In Sheets("Invoer").Range("A9:A500")
    
        [COLOR="Blue"]If [/COLOR]r.Value <> "" [COLOR="blue"]Then[/COLOR]
        Set rFoundCell = Sheets("Planning2").Range("A4:A8").Find(what:=r.Value, LookIn:=xlValues, lookat:=xlWhole)
        
        [COLOR="blue"]Else[/COLOR]
        
        [COLOR="blue"]If [/COLOR]a.Value <> "" [COLOR="blue"]Then[/COLOR]
        Set aFoundCell = Sheets("Planning2").Range("A12:A16").Find(what:=a.Value, LookIn:=xlValues, lookat:=xlWhole)
        
        End If

[COLOR="Red"]-------------------------------------------------------------------------------------------------------------      [/COLOR]          
        With rFoundCell
        
        .Offset(, r.Offset(, 2).Value - DateSerial(2007, 1, 1) + 1).Resize(, r.Offset(, 9).Value + 1).Interior.ColorIndex = 15
        .Offset(, r.Offset(, 5).Value - DateSerial(2007, 1, 1) + 1).Interior.ColorIndex = 3
                
        
        With aFoundCell
        
        .Offset(, a.Offset(, 2).Value - DateSerial(2007, 7, 1) + 1).Resize(, a.Offset(, 9).Value + 1).Interior.ColorIndex = 15
        .Offset(, a.Offset(, 5).Value - DateSerial(2007, 7, 1) + 1).Interior.ColorIndex = 3
        
        
        End With

Het bovenste gedeelte klopt volgens mij wel redelijk, maar dat weet ik niet zeker. Maar onder de rode streep weet ik niet hoe het verder moet. Misschien kun je me (nog) een duwtje in de goede richting geven!

Ik moet je teleurstellen, ook het bovenste gedeelte klopte niet. Ik heb snel die code wat aangepast zodat hij min of meer moet werken. Hiermee bedoel ik, ik heb hem niet getest, maar normaal gezien moet hij wel werken.
Bekijk hem maar eens rustig, doet hij niet wat hij moet doen laat maar iets horen, heb je er nog andere vragen over stel ze gerust.

[FONT="Courier New"]Dim r As Range
Dim rFoundCell As Range
Dim rngPeriode As Range
Dim Semester As Long
    
For Each r In Sheets("Invoer").Range("A9:A500")
  
    If r.Value <> "" Then
        If Month(r.Offset(, 2)) <= 6 Then  'dwz de maand van de startdatum is jan of feb of maa of apr of mei of jun
            Semester = 1
            Set rngPeriode = Sheets("planning2").Range("A4:A8")
        Else
            Semester = 2
            Set rngPeriode = Sheets("planning2").Range("A12:A16")
        End If
            
        Set rFoundCell = rngPeriode.Find(what:=r.Value, LookIn:=xlValues, lookat:=xlWhole)
             
       
        With rFoundCell
            If Semester = 1 Then
                .Offset(, r.Offset(, 2).Value - DateSerial(2007, 1, 1) + 1).Resize(, r.Offset(, 9).Value + 1).Interior.ColorIndex = 15
                .Offset(, r.Offset(, 5).Value - DateSerial(2007, 1, 1) + 1).Interior.ColorIndex = 3
            ElseIf Semester = 2 Then
                .Offset(, r.Offset(, 2).Value - DateSerial(2007, 7, 1) + 1).Resize(, r.Offset(, 9).Value + 1).Interior.ColorIndex = 15
                .Offset(, r.Offset(, 5).Value - DateSerial(2007, 7, 1) + 1).Interior.ColorIndex = 3
            End If
        End With
    End If
Next r[/FONT]

In deze code is wel nog geen rekening gehouden met overlopende periodes. Dat stuk moet er nog inkomen wil je een correcte weergave hebbe.

Finch

 

[toverkamp]

Finch,

de code werkt goed nu. Inderdaad doen de overlopende periodes het nog niet, maar ik ben er nu al superblij mee!!

Ik heb alleen nog een vraag. Wanneer je een project invoerd, kun je ook een omschrijving invoeren. Is het mogelijk om deze omschrijving in de juiste cel te zetten wanneer een project start. Ik denk dat het in de volgende code ergens moet komen te staan:

Dim r As Range
Dim rFoundCell As Range
Dim rngPeriode As Range
Dim Semester As Long
    
For Each r In Sheets("Invoer").Range("A9:A500")
  
    If r.Value <> "" Then
        If Month(r.Offset(, 2)) <= 6 Then  'dwz de maand van de startdatum is jan of feb of maa of apr of mei of jun
            Semester = 1
            Set rngPeriode = Sheets("planning2").Range("A4:A8")
        Else
            Semester = 2
            Set rngPeriode = Sheets("planning2").Range("A12:A16")
        End If
            
        Set rFoundCell = rngPeriode.Find(what:=r.Value, LookIn:=xlValues, lookat:=xlWhole)
             
       
        With rFoundCell
            If Semester = 1 Then
                .Offset(, r.Offset(, 2).Value - DateSerial(2007, 1, 1) + 1).Resize(, r.Offset(, 9).Value + 1).Interior.ColorIndex = 15
                .Offset(, r.Offset(, 5).Value - DateSerial(2007, 1, 1) + 1).Interior.ColorIndex = 3
            [COLOR="Red"]Hier moet denk ik een regel komen die de omschrijving in de eerste cel neerzet[/COLOR]
            ElseIf Semester = 2 Then
                .Offset(, r.Offset(, 2).Value - DateSerial(2007, 7, 1) + 1).Resize(, r.Offset(, 9).Value + 1).Interior.ColorIndex = 15
                .Offset(, r.Offset(, 5).Value - DateSerial(2007, 7, 1) + 1).Interior.ColorIndex = 3
            [COLOR="Red"]Hier moet denk ik een regel komen die de omschrijving in de eerste cel neerzet[/COLOR]
            End If
        End With
    End If
Next r

Voorbeeld:
Een project start op 1 januari 2007 en duurt t/m 10 januari 2007. In de cel 1-1-07 in het blad "Planning2" zou ik dan graag de omschrijving van het project zien staan, zodat je in die gekleurde balken kunt zien welk project het is.