I couldn't really figure out what your conditions were, but this should get
your started.

Sub Shades()
Worksheets("Print & Shading Page").Select
Dim cell As Range
Dim PSP As Worksheet
Set PSP = Worksheets("Print & Shading Page")
For Each cell In PSP.Range("c8:r30")

If cell.Value < "" Then
If (cell.Value - Date) 30 Then
With cell.Interior
.ColorIndex = 35
.Pattern = xlSolid
End With
ElseIf (cell.Value - Date) 14 Then
With cell.Interior
.ColorIndex = 36
.Pattern = xlSolid
End With
ElseIf (cell.Value - Date) 1 Then
With cell.Interior
.ColorIndex = 38
.Pattern = xlSolid
End With
ElseIf (cell.Value - Date) < 1 Then
With cell.Interior
.ColorIndex = 2
.Pattern = xlSolid
End With
End If
End If
Next
End Sub

--
Regards,
Tom Ogilvy


"Corey" wrote:

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...