Try this:

'----------------------------------
Sub colors()

Dim iRow As Long
Dim iCol As Long

'Boucle sur les colonnes
For iCol = Range("F7").Column To Range("R7").Column Step 7
'Boucle sur les lignes
For iRow = Range("F7").Row To Range("R48").Row Step 2
doRange Cells(iRow, iCol)
Next iRow
Next iCol

End Sub

Sub doRange(rngTopLeft As Range)
With rngTopLeft.Resize(2, 7)
If rngTopLeft.Value < Date Then
.Interior.Pattern = xlGray50
Else
.Interior.Pattern = xlSolid
End If
If rngTopLeft.Value = 1 And .Interior.ColorIndex = 15 Then _
.Interior.ColorIndex = 37
If rngTopLeft.Value = "" Then _
.Interior.ColorIndex = 15
End With
End Sub
'------------------------------

Cheers,
--
AP


"rwnelson" a écrit dans le message de
oups.com...
Thank you for your response but this code did not work.

The cell shading line shaded all cells. If the top left target cell
value was not < the current date, all cells from F7:S48 were still
shaded except for ranges F7:L8, F21:L22, and F35:L36.

This code turned all cells except the above-mentioned ranges gray
without regard to the date and it turned range F7:L8 colorindex 37
while F21:L22 and F35:L36 had no color.

The original code did not go down to the bottom of the calenar so I
edited to following line from:

For iRow = Range("F7").Row To Range("R35").Row Step 2

to

For iRow = Range("F7").Row To Range("S48").Row Step 2
___________

This was the only fix I could find that helped. Granted I'm not too
familiar with programming but looking at the code, it seemed logical
and it looks like it should work but for some reason it didn't.