Macro: Changing cell color based on date in cell

AinMn

New Member
Joined
Jun 20, 2010
Messages
7
Hi,

I need help writing a macro. Column D is filled with various dates. D2 might be 23/05/2010, D3 might be 12/06/2010, etc. While Cell in Column E might contain text, e.g. "Exceed Target Date", etc. Also, the number of rows is unknown and may be as large as a thousand or more. There also might be blank cells in the column too.

I need a macro that will go through Column D and Column G separately and change the Fill Color based on criteria, compared to today's date:

- If the date in the cell is prior to today's date, the cell's fill color should change to red

- If the date in the cell is the same as today's date, the cell's fill color should change to yellow

- If the date in the cell is 1 or 2 days after today, the cell's fill color should change to green

- If the date is 3 days or beyond after today's date, or if the cell contains text or is blank, the cell should remain white (or be filled with white, if it wasn't already)

And i would also like Cell in Column E turns to red, whenever the target date is passed.

Ideally, this macro should be run everytime the excel document is opened. Additionally, the code needs to change things appropriately. For example, if I open the document today (21/06/2010) and it finds the date 22/06/2010, it should change that fill to red. Then when I open tomorrow, since the date will now be today's date, it should change the red to yellow, as per the criteria above.

Your help is highly appreciated.<!-- / message --><!-- BEGIN TEMPLATE: ad_showthread_firstpost_sig --><!-- END TEMPLATE: ad_showthread_firstpost_sig -->
 

Excel Facts

Whats the difference between CONCAT and CONCATENATE?
The newer CONCAT function can reference a range of cells. =CONCATENATE(A1,A2,A3,A4,A5) becomes =CONCAT(A1:A5)
Hi AinMn,

try this code in Workbook Open Event -
Code:
Sub test()
Dim i As Integer
For i = Range("D5000").End(xlUp).Row To 2 Step -1 'Range upto 5000, chnge this as per your requirment
 
    If CDate(Cells(i, 4)) >= VBA.Date() + 3 Or Application.IsText(Cells(i, 4)) = True Or Cells(i, 4) = vbNullString Then Cells(i, 4).Interior.ColorIndex = 2
    If CDate(Cells(i, 7)) >= VBA.Date() + 3 Or Application.IsText(Cells(i, 7)) = True Or Cells(i, 4) = vbNullString Then Cells(i, 4).Interior.ColorIndex = 2
    If CDate(Cells(i, 4)) >= VBA.Date() + 1 And CDate(Cells(i, 4)) <= VBA.Date() + 2 Then Cells(i, 4).Interior.ColorIndex = 4
    If CDate(Cells(i, 7)) >= VBA.Date() + 1 And CDate(Cells(i, 7)) <= VBA.Date() + 2 Then Cells(i, 7).Interior.ColorIndex = 4
 
    Select Case VBA.CDate(Cells(i, 4))
 
    Case Is < VBA.Date()
        Cells(i, 4).Interior.ColorIndex = 3
        Cells(i, 7).Interior.ColorIndex = 3
    Case Is = VBA.Date()
        Cells(i, 4).Interior.ColorIndex = 6
        Cells(i, 7).Interior.ColorIndex = 6
 
   End Select
Next
End Sub

would you please tell me what do u mean by "And i would also like Cell in Column E turns to red, whenever the target date is passed."
 
Upvote 0
Hi,

welcome to the board........

In Module...

Code:
Sub colouring()
Dim cell As Range
    For Each cell In Sheet1.Range("D2:D" & Sheet1.Range("D" & Rows.Count).End(xlUp).Row)
    If Not IsDate(cell.Value) Then GoTo X:
    If IsEmpty(cell.Value) Then GoTo X:
        If cell.Value < Date Then
            cell.Interior.ColorIndex = 3
        
        ElseIf cell.Value = Date Then
                             
            cell.Interior.ColorIndex = 4
        
        ElseIf cell.Value - Date >= 1 And cell.Value - Date <= 2 Then
            
            cell.Interior.ColorIndex = 6
            
        Else
X:
        cell.Interior.ColorIndex = 0
        
        End If
 
Next cell
End Sub

In Thisworkbook---------
Code:
Private Sub Workbook_Open()
Call colouring
End Sub

in worksheet where you want... in my case sheet is sheet1 ....

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 4 Then
Call coluring
End If
End Sub


HTH
-------------------------------------
 
Upvote 0
Sure like the VBA solutions but, would it not be more efficient to use an "NOW()" statement under Conditional Formatting?

EX: Formula is =NOW() > D# For the E column

EX: Cell value is equal to =NOW() For the D column

Or whatever your parameters are.

Just a thought.
 
Upvote 0
Sure like the VBA solutions but, would it not be more efficient to use an "NOW()" statement under Conditional Formatting?

EX: Formula is =NOW() > D# For the E column

EX: Cell value is equal to =NOW() For the D column

Or whatever your parameters are.

Just a thought.

Ofcourse, but you can not use more than three condition in conditional formating where as VBA can use unlimited conditions
 
Upvote 0
Hi G2k,

I have used the codes, it works fine. Thanks for that. What i mean by ( "And i would also like Cell in Column E turns to red, whenever the target date is passed." ) is :-

1. Whenever date in Column D(Cell e.g.D2) is greather than today's date, then the cell will turn red. Whilst, Column E (Cell e.g.E2) should correspond to date in D2 with the text message "Exceed target date" with font color in red.
2. Whenever date in Column D is overdue, the cell in Column E will display the text in red color font.

Does it make any sense?
I wanted to attach an image for your better idea on what i'm trying to say here, but i can't seem to insert the image here.. Any idea how?


Rgds
 
Upvote 0
Hi G2k,

I have used the codes, it works fine. Thanks for that. What i mean by ( "And i would also like Cell in Column E turns to red, whenever the target date is passed." ) is :-

1. Whenever date in Column D(Cell e.g.D2) is greather than today's date, then the cell will turn red. Whilst, Column E (Cell e.g.E2) should correspond to date in D2 with the text message "Exceed target date" with font color in red.
2. Whenever date in Column D is overdue, the cell in Column E will display the text in red color font.

Does it make any sense?
I wanted to attach an image for your better idea on what i'm trying to say here, but i can't seem to insert the image here.. Any idea how?


Rgds

do you mean that in both conditions (cell value in D2 is > or cell value in D2 < date) the cell color would change in red?

what would be cell color in column E if date is equal to current date?
 
Upvote 0
sorry, but
Did you try mine code... it will do each thing you want


Yes, i did try your code. It works the same. But when the cell value have not reached the today's date, the cell color change to red. What i want is that
1. When the cell value have already passed, the cell color to change to green or yellow.

I try to insert the image here but its not working. how do i insert image in my post? Any idea?
 
Upvote 0

Forum statistics

Threads
1,214,376
Messages
6,119,174
Members
448,870
Latest member
max_pedreira

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top