Please read through to the end.  I want a macro.  I do NOT want
conditional formatting.  I have an excel spreedsheet which calculates
"to do" dates.  I want the "to do" cells to change color based on
todays date AND the calculated date in the cell.
What I am doing is making a work schedule for the farm. There are
hundreds of animals which need different things on each day. I want to
be able to print a color subsection of a sheet to provide a list of
animals which need a particular thing accomplished. When I look at a
sheet the colors stand out.

Here is a small section of my spreedsheet:
Cell A2 input a id number 
Cell B2 input a id number 
Cell C2 input a date 
Cell D2 input a number 
Cell E2 calculated formula =IF(C2="","",C2+14) 
Cell F2 input a number 
Cell G2 calculated formula =IF(E2="","",E2+14) 
Cell H2 input a number 
Cell I2 calculated formula =IF(G2="","",G2+14) 
Cell J2 input a number 
Cell K2 calculated formula =IF(I2="","",I2+14) 
Cell L2 input a number 



Here is an detailed description of what I need:
Orange is future.
Blue is a 5 day window around calculated date.
Red is past due.
Green is completed.
Let us just work with one row (number 2) and columns C through F. 
I fill in manually A2 through D2. 
Cell E2 generates a date using the formula =IF(C2="","",C2+14). 

Premise 
Input to C is Feb 15. This value will never change. 
Input to D is 8. This value will never change. 
Calculated date in E is Feb 29. This value will never change. 

Changes --- 
Todays date changes every day (internal computer date). 
F2 will be filled one time and never change. --- 

HERE IS HOW IT WORKS:
First condition
Data is inputed to A2 to D2 AND cell F2 is blank.
Time goes bye.

Today is Feb 15. Cell E2 is colored Orange. 
Today is Feb 26. Cell E2 is colored Orange. 
Today is Feb 27. Cell E2 is colored Blue. 
Today is March 2. Cell E2 is colored Blue. 
Today is March 3. Cell E2 is colored Red. 
Today is May 23. Cell E2 is colored Red. 

Second Condition:
Cell F2 is filled in. Today is ANY date. 
Cell E2 is colored green and never changes. 

The only cell to change color is E2. No other rows or cells will
change color based on the C2, D2, E2 or F2 data or today's date. The
other calculated date cells will each need to color change but are to
be ignored in this example only. The other calculated date cells and
their adjacent number inputed cells need to be included in the final
supplied macro.

I hope this will make the result I need clear to you. 
Thank you.

---

Clarification of Question by i_am_at_home-ga on 07 Jul 2004 17:58 PDT

Hi cynthias-ga,
This worked just as I needed.  Thank you very much.
I do have a few questions.  I had to list each individual cell for
each column in the cellList.  Is there a way to designate the entire
column?  It is just not fesable to list every cell individually for
thousands of cells.
I get an error message Run-Time error '1004"  Method 'Range" of object
'_Global' failed.  How do I correct this?
Is there a way to have this macro run everytime the sheet is opened? 
Also, is there a way to have this run everytime there is data entered
somewhere?
Should I want to change the color for a type such as insted of Orange
use Yellow is there a way to do this?
Can C2 be green when D2 is filled in?
Last, is there a way to print a color?
Again, Thank you very much!!!

---

Clarification of Question by i_am_at_home-ga on 08 Jul 2004 11:59 PDT

Hi again,

The test message is about the only thing I understand about macros!
Most of what you say about the macro is foreign language to me.

Sorry about the conditional formatting tone, but I got a lot of people
recommending that and I need more than the at will allow.

In the final macro, there will have to be tens of thousands of rows
included in the CellList. It is just impossible to put them in by
hand. I tried to make a "range" by using c2...c65000 but it just
filled in all of them regardless if the D column had a value inputted.
I sure hope it is simple to manipulate.

I went to Microsoft and d/l all the updates they have and it made no
difference in the error message.

I have no security issues. I sure would like it to run on opening and event.

The print a color is referring to making a list of the ID#'s from cell
A2 or B2 where a red color or blue color is present anywhere in the
row. Sorry if I am not clear most of the time. It is very difficult to
describe exactly what I need by typing it out.

Again, thank you for all your thoughtful help.

---

Clarification of Question by i_am_at_home-ga on 08 Jul 2004 15:01 PDT

I am using:
Sub Colorcell()
'
' Colorcell Macro
'
'


'
    Dim CellList(100) As String
    CellList(1) = "E2"
    CellList(2) = "G2"
    CellList(3) = "I2"
    CellList(4) = "K2"
    CellList(5) = "M2"
    CellList(6) = "O2"
    CellList(7) = "Q2"
    CellList(8) = "S2"
    CellList(9) = "U2"
    CellList(10) = "C2"
    LastCell = 100
    
    For i = 1 To LastCell
       ColorDate (CellList(i))
    Next
        
End Sub


Sub ColorDate(cell)
' color a cell based upon the date
    Dim MyDate
    MyDate = Date
    yellow = 6
    orange = 45
    blue = 5
    red = 3
    green = 4
    
    Range(cell).Select
    nextcell = ActiveCell.Offset(0, 1)
    If nextcell = "" Then
    Select Case (Selection - MyDate)
        Case Is > 2
            Selection.Interior.ColorIndex = yellow
        Case -2 To 2
            Selection.Interior.ColorIndex = blue
        Case Is < -2
            Selection.Interior.ColorIndex = red
    End Select
    Else
        Selection.Interior.ColorIndex = green
    End If
       
    
End Sub

This is copied and pasted.  The CellList takes me up to about 5 months.

I added C2 to the cell list and it worked just fine.  Yes, the cell to
the right is the trigger for the color green.

The same error still shows up everytime it runs.  The debug points to 
Range(cell).Select

Must be nice to be able to do all this!  Thank you.

---

Clarification of Question by i_am_at_home-ga on 08 Jul 2004 18:18 PDT

Hi,
Changing my typo from 100 to 10 got rid of the error message!  Who knew ;-)

If it gets too slow, I can just remove that part of the second macro.

Just how can you put in all the additional rows without typing in
every cell reference individually?

How many ways can I say Thank you.

---

Clarification of Question by i_am_at_home-ga on 11 Jul 2004 15:16 PDT

Looks great but I get an error type mismatch.  Here are all the macros
I have typed in:
Sub Colorcell()
'
' Colorcell Macro
'
'


'
    Dim CellList(200) As String
    Dim act As Object
    
    CellList(1) = "C2:C100"
    CellList(2) = "E2:E100"
    CellList(3) = "G2:F100"
    CellList(4) = "I3:I100"
    CellList(5) = "K2:K100"
    CellList(6) = "M2:M100"
    CellList(7) = "O2:O100"
    CellList(8) = "Q2:Q100"
    CellList(9) = "S2:S100"
    CellList(10) = "U2:U100"

    LastCell = 10
    Set act = ActiveCell
        
    For i = 1 To LastCell
        colon = InStr(CellList(i), ":")
        CLi = CellList(i)
        If colon > 0 Then
            BeginCell = Left$(CLi, colon - 1)
            EndCell = Mid$(CLi, colon + 1, Len(CLi) - colon)
            bcr = Range(BeginCell).Row
            ecr = Range(EndCell).Row
            rowoffset = ecr - bcr
            For j = 0 To rowoffset
                ColorDate (Range(BeginCell).Offset(j, 0).Address)
            Next j
        Else
            ColorDate (CellList(i))
        End If
    Next i
    Range(act.Address).Select
End Sub


Sub ColorDate(cell)
' color a cell based upon the date
    Dim MyDate
    MyDate = Date
    yellow = 6
    orange = 45
    blue = 5
    red = 3
    green = 4
    
    Range(cell).Select
    nextcell = ActiveCell.Offset(0, 1)
    If nextcell = "" Then
    Select Case (Selection - MyDate)
        Case Is > 2
            Selection.Interior.ColorIndex = yellow
        Case -2 To 2
            Selection.Interior.ColorIndex = blue
        Case Is < -2
            Selection.Interior.ColorIndex = red
    End Select
    Else
        Selection.Interior.ColorIndex = green
    End If
       
    
End Sub

Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
    Application.Run ("Sheet1.Colorcell")
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, _
        ByVal Source As Range)
    Application.Run ("Sheet1.Colorcell")
End Sub

Also, in C the rest of the column where there is no entry in C or D
the cells are colored red.
TY.

---

Clarification of Question by i_am_at_home-ga on 12 Jul 2004 18:11 PDT

I replaced the code and it made no change.  Still error 13 
The debug points to that particular private sub line:
Application.Run ("Sheet1.Colorcell")
HEE HEE  How about if A2 or B2 is blank or 0 then do nothing would
seem to be another way to not color and give me another check on my
manual entries.
Ahhhh, the finish line is CLOSE!

---

Clarification of Question by i_am_at_home-ga on 15 Jul 2004 08:02 PDT

Hi,
I changed them to sheet1 because I will have different requirements in
the other sheets.  I just put them back into this workbook and
Module1.
I pasted the latest addition into ColorCell at the end.
I am getting the type mismatch erroe 13 still, but now it debugs to
Select Case (Selection - MyDate).
I noticed that the color changes in column C and E but not the
remainder.  And the cells which are blank in C and E are colored with
the last color filled in corrrectly.

Here is all of it again:

This workbook
Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
    Application.Run ("Module1.Colorcell")
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Source As Range)
    Application.Run ("Module1.Colorcell")
End Sub

Module1
Sub Colorcell()
'
' Colorcell Macro
'
'


'
    Dim CellList(200) As String
    Dim act As Object
    
    CellList(1) = "C2:C100"
    CellList(2) = "E2:E100"
    CellList(3) = "G2:F100"
    CellList(4) = "I3:I100"
    CellList(5) = "K2:K100"
    CellList(6) = "M2:M100"
    CellList(7) = "O2:O100"
    CellList(8) = "Q2:Q100"
    CellList(9) = "S2:S100"
    CellList(10) = "U2:U100"

    LastCell = 10
    Set act = ActiveCell
        
    For i = 1 To LastCell
        colon = InStr(CellList(i), ":")
        CLi = CellList(i)
        If colon > 0 Then
            BeginCell = Left$(CLi, colon - 1)
            EndCell = Mid$(CLi, colon + 1, Len(CLi) - colon)
            bcr = Range(BeginCell).Row
            ecr = Range(EndCell).Row
            rowoffset = ecr - bcr
            For j = 0 To rowoffset
                ColorDate (Range(BeginCell).Offset(j, 0).Address)
            Next j
        Else
            ColorDate (CellList(i))
        End If
    Next i
    Range(act.Address).Select
    
    For j = 0 To rowoffset
                If Range(BeginCell).Offset(j, 0) <> "" Then
                    ColorDate Range(BeginCell).Offset(j, 0).Address
                End If
            Next j
End Sub


Sub ColorDate(cell)
' color a cell based upon the date
    Dim MyDate
    MyDate = Date
    yellow = 6
    orange = 45
    blue = 5
    red = 3
    green = 4
    
    Range(cell).Select
    nextcell = ActiveCell.Offset(0, 1)
    If nextcell = "" Then
    Select Case (Selection - MyDate)
        Case Is > 2
            Selection.Interior.ColorIndex = yellow
        Case -2 To 2
            Selection.Interior.ColorIndex = blue
        Case Is < -2
            Selection.Interior.ColorIndex = red
    End Select
    Else
        Selection.Interior.ColorIndex = green
    End If
    
       
    
End Sub



Thanks very much

Once you've created *any* macro, you can go into your Edit Macro
information and copy and paste this. I am not a Google Answers
Researcher.

Colorcell is the macro, and ColorDate is a function. IF you populate
the list appropriately, and change the LastCell=2 to however many
cells you need to color, this will visit each cell and do its thing.
Please let me know if it works or doesn't. It *is* a macro and not
conditional formatting.

Sub Colorcell()
'
' Colorcell Macro
' 
'


'
    Dim CellList(200) As String
    CellList(1) = "E2"
    CellList(2) = "G2"
    LastCell = 2
    
    For i = 1 To LastCell
       ColorDate (CellList(i))
    Next
        
End Sub


Sub ColorDate(cell)
' color a cell based upon the date
    Dim MyDate
    MyDate = Date
    orange = 45
    blue = 5
    red = 3
    green = 4
    
    Range(cell).Select
    nextcell = ActiveCell.Offset(0, 1)
    If nextcell = "" Then
    Select Case (Selection - MyDate)
        Case Is > 2
            Selection.Interior.ColorIndex = orange
        Case -2 To 2
            Selection.Interior.ColorIndex = blue
        Case Is < -2
            Selection.Interior.ColorIndex = red
    End Select
    Else
        Selection.Interior.ColorIndex = green
    End If
       
    
End Sub

test

Sorry about the test message. 

Well, your statement about not wanting conditional formatting puts a
damper on the answer to your clarification.

I realize that you only get three shots in conditional formatting, but
it really is the recommended way to go for your request.

If you want to designate an entire column, I think that's reasonable
to do, but it requires a much bigger Dim of CellList. I wasn't really
prepared for "thousands" of cells to be changed, obviously, but the
code is very very simple to manipulate.

The Error message has a twofold problem/solution. If you've not
updated the service release(s) for Excel, it's a good time to do so.
On the other hand, I did violate a MS issue by not using absolute
references in Range (It'd work better if I had actually included the
worksheet in the Range line.) Still, for security and bug fixes, I'd
recommend getting Office updated with a service pack. It may or may
not fix the issue.

The macro may be able to run on open, although that may be a security
issue. The macro can be run with a Worksheet event, if reprogrammed...
I think that may be good for a researcher to tackle. If I can, I'll do
it later tomorrow.

You can add any color you wish, of course.
http://www.mvps.org/dmcritchie/excel/colors.htm has a list of colors
(yellow =6). Just put the colorname =colornumber in the appropriate
place in ColorDate, and change the word where you want it.

The code is very generic in its configuration. For each of the cells
you want colored, it checks the cell to the right (nextcell) to see if
there is anything there. If so, green, otherwise, based upon date
difference.

I don't know how to answer the question "is there a way to print a
color?" properly. A color printer should pick up the colors to print,
one would guess. Do you want a legend? Create it on another worksheet
manually.

Even if you're not a programmer, there are so few actual lines of code
that you can follow the logic rather easily. (Loop through the
celllist, and color based upon date).

I don't mind if a researcher finishes the request if I don't get to it.

May I assume that the trigger for green is to the right of any cell?
I'm going to leave the code as generic as possible..

Also, I'd like to know what your variation is on my code, because I
have run it all day without that error...

I'm still working on the issue of specifying entire columns. Whatever
changes I make, I don't want to upset it if you want to color code one
cell...

I figured out how to make the macro run on startup...
It's messy, but here goes. 
You know the little submenu icon that's in the upper right-hand corner
of your worksheet? Not the Excel Application one at the top, but the
smaller one... right-click on it and choose "View Code"

I should warn you that this code working on thousands of records EVERY
TIME YOU CHANGE A FIELD will possibly be abysmally slow. Copy and
paste the following:
Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
    Application.Run ("Module1.Colorcell")
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, _
        ByVal Source As Range)
    Application.Run ("Module1.Colorcell")
End Sub

btw:
    CellList(10) = "C2"
    LastCell = 10 'this number must be the last number in the
parentheses in CellList

This was harder than I thought. I figured it out, though. Also, I made
it so the code politely returns your cursor to where it was when the
code ran. I know *i'd* want that feature.. This is a drop-in
replacement for Colorcell, although you are welcome to keep any
CellList you have. Here's a warning: there are no error checking
provisions, and any range you have in CellList MUST be
a) in the same column, 
b) numerically increasing
c) in the format of "C2:C100" (2 and 100 can be any number. The : is important).

However, you can have 
CellList(1)="C2:C100"
CellList(2)="E2:E100"
CellList(3)="G20"
(See, nice, isn't it?)
Don't forget to be consecutive in the numbering of CellList(#), and
adjust LastCell appropriately.

Sub Colorcell()
'
' Colorcell Macro
'
'


'
    Dim CellList(200) As String
    Dim act As Object
    
    CellList(1) = "E2"
    CellList(2) = "G2"
    CellList(3) = "E3:E10"
    LastCell = 3
    Set act = ActiveCell
        
    For i = 1 To LastCell
        colon = InStr(CellList(i), ":")
        CLi = CellList(i)
        If colon > 0 Then
            BeginCell = Left$(CLi, colon - 1)
            EndCell = Mid$(CLi, colon + 1, Len(CLi) - colon)
            bcr = Range(BeginCell).Row
            ecr = Range(EndCell).Row
            rowoffset = ecr - bcr
            For j = 0 To rowoffset
                ColorDate (Range(BeginCell).Offset(j, 0).Address)
            Next j
        Else
            ColorDate (CellList(i))
        End If
    Next i
    Range(act.Address).Select
End Sub

PS: I think you might ask the "print color" question separately. 

Simply phrased: In Excel, how do I get a list of IDs from A(row#) or
B(row#) that might have a cell color of red or blue somewhere in the
same row?

Although I can answer that (in a comment), I think it'd be worth
asking the question separately for possible Google Answers Searches in
the future. Please don't expire this question until you're certain the
other provided solution works for you.

Also note that, although I won't give you direct contact information
here in Google Answers, I'm pretty certain I'm the only one in any Web
Search with my username.

OK, I'm trying to figure out where the mismatch is coming from. Do you
have a debug information?

And, yes, cells will turn red if you reference them with no
information, because they will subtract from the current day and be
greater than 2 days...

If you can help me where your type mismatch debugs to (line?), I'll
put in the check to not do anything if there isn't any date. :) Of
course, if you didn't reference it... heh heh heh :)

somehow I think 
Private Sub Workbook_SheetChange(ByVal Sh As Object, _
        ByVal Source As Range)
    Application.Run ("Sheet1.Colorcell")
End Sub

should be 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Source As Range)
    Application.Run ("Sheet1.Colorcell")
End Sub

and see what happens.

Why did you change from Module1 to Sheet1? It really needs to be
Module1 unless the macros are in another module... Also, the Private
Sub's are supposed to be in "ThisWorkbook"...

change/update this section in ColorCell (basically, add the If and End If lines):
            For j = 0 To rowoffset
                If Range(BeginCell).Offset(j, 0) <> "" Then
                    ColorDate Range(BeginCell).Offset(j, 0).Address
                End If
            Next j

OK, this won't "FIX" anything that's miscolored. 

There is one new variable (Sheet=)that allows you to select which ONE
sheet you'd like to color. If you want to color multiple sheets,
you'll have to copy the macro, change the macro Name and sub name and
Sheet= to the appropriate change.

I'm fairly certain that this is the final change necessary.

Sub Colorcell()
'
' Colorcell Macro
'
'

'
    Dim CellList(200) As String
    Dim act As Object
    
    CellList(1) = "C2:C100"
    CellList(2) = "E2:E100"
    CellList(3) = "G2:F100"
    CellList(4) = "I3:I100"
    CellList(5) = "K2:K100"
    CellList(6) = "M2:M100"
    CellList(7) = "O2:O100"
    CellList(8) = "Q2:Q100"
    CellList(9) = "S2:S100"
    CellList(10) = "U2:U100"

    LastCell = 10
    Sheet = "Sheet1"
    If ActiveCell.Worksheet.Name = Sheet Then
    Set act = ActiveCell
        
    For i = 1 To LastCell
        colon = InStr(CellList(i), ":")
        CLi = CellList(i)
        If colon > 0 Then
            BeginCell = Sheet + "!" + Left$(CLi, colon - 1)
            EndCell = Sheet + "!" + Mid$(CLi, colon + 1, Len(CLi) - colon)
            bcr = Range(BeginCell).Row
            ecr = Range(EndCell).Row
            rowoffset = ecr - bcr
            For j = 0 To rowoffset
                If Range(BeginCell).Offset(j, 0) <> "" Then
                    ColorDate (Range(BeginCell).Offset(j, 0).Address)
                End If
            Next j
        Else
        If Range(CellList(i)) = "" Then
                ColorDate (Sheet + "!" + CellList(i))
        End If
        End If
    Next i
    Range(act.Address).Select
    End If
End Sub

I can't believe it... grr. Here's the *real* last one. While the
previous would have worked for you, it wouldn't have colored single
cells. You wouldn't have noticed, probably, but I did.

Sub Colorcell()
'
' Colorcell Macro
'
'

'
    Dim CellList(200) As String
    Dim act As Object
    
    CellList(1) = "C2:C100"
    CellList(2) = "E2:E100"
    CellList(3) = "G2:F100"
    CellList(4) = "I3:I100"
    CellList(5) = "K2:K100"
    CellList(6) = "M2:M100"
    CellList(7) = "O2:O100"
    CellList(8) = "Q2:Q100"
    CellList(9) = "S2:S100"
    CellList(10) = "U2:U100"

    LastCell = 10
    Sheet = "Sheet1"
    If ActiveCell.Worksheet.Name = Sheet Then
    Set act = ActiveCell
        
    For i = 1 To LastCell
        colon = InStr(CellList(i), ":")
        CLi = CellList(i)
        If colon > 0 Then
            BeginCell = Sheet + "!" + Left$(CLi, colon - 1)
            EndCell = Sheet + "!" + Mid$(CLi, colon + 1, Len(CLi) - colon)
            bcr = Range(BeginCell).Row
            ecr = Range(EndCell).Row
            rowoffset = ecr - bcr
            For j = 0 To rowoffset
                If Range(BeginCell).Offset(j, 0) <> "" Then
                    ColorDate (Range(BeginCell).Offset(j, 0).Address)
                End If
            Next j
        Else
        If Range(Sheet + "!" + CellList(i)) <> "" Then
                ColorDate (Sheet + "!" + CellList(i))
        End If
        End If
    Next i
    Range(act.Address).Select
    End If
End Sub