How do you format a calendar to show a 4 day cycle?

[SNA400]

HI All,

This may be a simple question but for the likes of me I cannot work out what I need to do.

We have 4 people who work a 4 on 4 off shift pattern, and we need a way to format with colour a yearly calendar to show what days they are working without having to highlight every 4 days and manually colour them.

1st question - is this possible?
and if so How??

an example is shown below

We need to be able to do this every year matching the pattern from the previous year.

If anyone can help it would be much appreciated

Simon

 

[NoSparks]

I ran this against a blank sheet and believe it produced what you're after.

Sub ShiftPattern()
    Dim i As Long, r As Long, c As Long
    Dim dte As Date
    
dte = #1/1/2025#

With ActiveSheet
    For c = 2 To 24 Step 2
        For r = 2 To 32
            Select Case dte Mod 8
                Case 0
                    .Cells(r, c).Interior.Color = RGB(148, 200, 0) ' green
                    .Cells(r, c + 1).Interior.Color = RGB(204, 255, 51) 'lime
                Case 1
                    .Cells(r, c).Interior.Color = RGB(148, 200, 0) ' green
                    .Cells(r, c + 1).Interior.Color = RGB(129, 202, 235) 'blue
                Case 2
                    .Cells(r, c).Interior.Color = RGB(148, 200, 0) ' green
                    .Cells(r, c + 1).Interior.Color = RGB(129, 202, 235) 'blue
                Case 3
                    .Cells(r, c).Interior.Color = RGB(250, 191, 143) 'orange
                    .Cells(r, c + 1).Interior.Color = RGB(129, 202, 235) 'blue
                Case 4
                    .Cells(r, c).Interior.Color = RGB(250, 191, 143) 'orange
                    .Cells(r, c + 1).Interior.Color = RGB(129, 202, 235) 'blue
                Case 5
                    .Cells(r, c).Interior.Color = RGB(250, 191, 143) 'orange
                    .Cells(r, c + 1).Interior.Color = RGB(204, 255, 51) 'lime
                Case 6
                    .Cells(r, c).Interior.Color = RGB(250, 191, 143) 'orange
                    .Cells(r, c + 1).Interior.Color = RGB(204, 255, 51) 'lime
                Case 7
                    .Cells(r, c).Interior.Color = RGB(148, 200, 0) ' green
                    .Cells(r, c + 1).Interior.Color = RGB(204, 255, 51) 'lime
            End Select
            
            If Weekday(dte, 1) = 1 Then .Cells(r, c).Value = "SUNDAY"
            
            dte = dte + 1
            If Day(dte) = 1 Then Exit For
        Next r
    Next c
End With

End Sub

adjust the rgb colors to match the colors you're actually using.

Hope that helps

 

[Kaper]

Another approach would be without VBA.
Just by using conditional formatting.

Sheet preparation:
In column A (A2:A32) write numbers 1..31.
In B1 (merged with C1) write Jan 1st 2025
In D1 (merged with E1) write formula:

=DATE(YEAR(B1),MONTH(B1)+1,1)

Format these cells as custom format mmm to display just month names (on screenshot you will see Polish month names - you will see them in accordance with your local settings)
Copy formula from D1(merged with E1) to next cell right until december is visible (in merged X1 and Y1.

And now Conditional formatting itself:
Select B2:Y32 and use 5 times Home->Conditional Formatting->New Rule->Use formula to ... writing such formulas and selecting respective color cell filling.

green	=AND(MOD(B$1+$A2,8)<4,B$1<>"")
pink	=AND(MOD(B$1+$A2+4,8)<4,B$1<>"")
blue	=AND(MOD(A$1+$A2-2,8)<4,A$1<>"")
yellow	=AND(MOD(A$1+$A2+2,8)<4,A$1<>"")
grey	=OR(AND(A$1<>"",MONTH(A$1)<>MONTH(A$1+$A2-1)),AND(B$1<>"",MONTH(B$1)<>MONTH(B$1+$A2-1)))

Check if last formula takes precedence over all ather (and 30th Feb, etc.) are grayed as these are not correct dates (you may want to format these cells as white fill too, to make them looking just empty)

If you change the date in B1 to Jan 1st, 2026 you will notice the sequence from last days of Dec 2025 continues (starts with 4 green and 2 yellow, while last days in Dec were 4 pink and 2 yellow)


Sust in case - writing sundays in cells could be also done with formula. the formula would be (for B1 and copied right and down

=IF(AND(B$1<>"",WEEKDAY(B$1+$A2-1)=1,MONTH(B$1)=MONTH(B$1+$A2-1)),"SUNDAY","")

note that some rows and column are shrinked to show ends of months and end of year 2025