I have got so far but i get an error now in this:

Sub Shades()
worksheets("Print & Shading Page").Select
Dim cell As Range
Dim PSP As Worksheet
For Each cell In worksheets("Print & Shading Page").Range("c8:r30")
With cell
If .Value < "" Then
PSP.Range(.Address).Value = TODAY() < 1
With Selection.Interior
.ColorIndex = 38
.Pattern = xlSolid
End With
Else
End If
If .Value < "" Then
PSP.Range(.Address).Value = TODAY() < 14
With Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
End With
Else
End If
If .Value < "" Then
PSP.Range(.Address).Value = TODAY() < 30
With Selection.Interior
.ColorIndex = 35
.Pattern = xlSolid
End With
Else
End If
If .Value < "" Then
PSP.Range(.Address).Value = TODAY() 1
With Selection.Interior
.ColorIndex = 2
.Pattern = xlSolid
End With
End If
End With
Next
End Sub

Any idea's where i am going wrong?

Corey....