Macro for comparing dates and giving output as mentioned

N

ninad_laud

New Member
Joined
Oct 1, 2014
Messages
7
Hello Friends,

I am new to this forum, so please forgive me if I missed on something

I need help with creating a macro for comparing dates.

Firstly I will update you with the basic information of Excel Version i.e Microsoft Office 2007

The column "O" in my excel sheet contains date in format mm/dd/yyyy (as we need to compare this column with today() date.

Basically there are 4 conditions that need to be checked

1) If the date mentioned in column "O" is ranging from Today() + (6days, 7days, 8 days, 9days, 10days) than it should give result in column "W" mentioning "High" filled with Yellow color.

2) If the date is ranging between Today() + (Today, 1day, 2day, 3day, 4day, 5day) than it should give result in same column "W" mentioning "Highest" filled with red color.

3) If the date is Today() + (Past date) and if in column "S" any apart from status "BLUE" is mentioned it should give result in column "W" mentioning "Highest" filled with red color.

4) Any other date it should show as Priority "Low" filled with Green Color

I am not sure whether it will be possible to create such a macro

I also apologise for my not so good explanation

Thanks in advance
 
Sort by date Sort by votes
why another column W. why not conditionally format in column O itself

select O2 and down till the data is there (first row is header)
click home ribbon-conditional formatting tab-new rules-use a formula ......(last item)
type
=today()-O2>=6
click format
choose fill(last item at the top)
and choose color
click ok ok

repeat for other conditions every time new rule
 
Upvote 0
venkat1926 said:
why another column W. why not conditionally format in column O itself

select O2 and down till the data is there (first row is header)
click home ribbon-conditional formatting tab-new rules-use a formula ......(last item)
type
=today()-O2>=6
click format
choose fill(last item at the top)
and choose color
click ok ok

repeat for other conditions every time new rule
Click to expand...

Firstly thanks venkat1926 for the instant solution

I tried to follow the exact steps mentioned by you, but some how its not working for me.

In mean time I have found one code which serves by purpose to some extent, but can it be possible to have few modifications so that it can completely serve my purpose

1) For e.g Inside of Just filling the cell with colours can we also add Text in the cell -
2) The code should also check if the date in O2 is within 1 week past the actual date than it should also be filled with red. If its more than 1week old than it should be left unfilled/blank


Code: 
'- a routine to color code some cells depending on due dates
Sub ColorCells()


   Dim rRange As Range
   Dim dToday As Date
   Dim numOfDays As Integer
   
   '- this is whatever cell you have placed the first date in
   Set rRange = Range("B2")
   '- this is today's date
   dToday = Now
   
   '- a do loop that will step down the rows of the worksheet until
   '- it finds a blank cell
   Do While rRange.Text <> ""
      '- the number of days between today and the doc date
      '- NOTE: the "d" tells the DateDiff function to return the difference
      '-       in days
      numOfDays = DateDiff("d", dToday, rRange.Text)
      '- with blocks simply save typing... here it applies everywhere you see
      '- .Color (it really means rRange.Offset(ColumnOffset:=1).Interior.Color = vbRed
      With rRange.Offset(ColumnOffset:=1).Interior
         '- i think the select statement is faster than a large if statement
         Select Case (numOfDays)
            '- if the doc date is within a week of today...
            Case Is <= 7
               '- ... make the color of the cell to the right red
               .Color = vbRed
            '- two weeks
            Case Is <= 14
               '- ... yellow
               .Color = vbYellow
            '- three weeks
            Case Is <= 21
               '- green (i used green, yellow, red because i did not find orange
               .Color = vbGreen
         End Select
      End With
      '- now move to the next row below and repeat the loop
      Set rRange = rRange.Offset(RowOffset:=1)
   Loop


End Sub
 
Upvote 0
I have slightly modified the macro. see whether it does what you want.

KEEP THE ORIGINAL FILE SAFELY SOMEWHERE FOR RETRIEVAL IF SOMETHING GOES WRONG


Code: 
Sub ColorCells()






   Dim rRange As Range
   Dim dToday As Date
   Dim numOfDays As Integer
   '================
   Worksheets("sheet1").Activate
   ActiveSheet.Columns("c:c").Cells.Clear
   '=================the above 2 codes are added to remove values and color.that is undo macro result
   '- this is whatever cell you have placed the first date in
   Set rRange = Range("B2")
   '- this is today's date
   dToday = Now
   
   '- a do loop that will step down the rows of the worksheet until
   '- it finds a blank cell
   Do While rRange.Text <> ""
      '- the number of days between today and the doc date
      '- NOTE: the "d" tells the DateDiff function to return the difference
      '-       in days
      numOfDays = DateDiff("d", dToday, rRange.Text)
      '- with blocks simply save typing... here it applies everywhere you see
      '- .Color (it really means rRange.Offset(ColumnOffset:=1).Interior.Color = vbRed
      With rRange.Offset(ColumnOffset:=1)
      
         '- i think the select statement is faster than a large if statement
         Select Case (numOfDays)
            '- if the doc date is within a week of today...
            Case Is <= 7
               '- ... make the color of the cell to the right red
               .Interior.Color = vbRed
               .Value = "within a week"
            '- two weeks
            Case 8 To 14
            
               '- ... yellow
               .Interior.Color = vbYellow
               .Value = "between 8 and 14"
            '- three weeks
            Case 15 To 21
               '- green (i used green, yellow, red because i did not find orange
               .Interior.Color = vbGreen
               .Value = "between 15 and 21"
         End Select
      End With
      '- now move to the next row below and repeat the loop
      Set rRange = rRange.Offset(RowOffset:=1)
   Loop




End Sub
 
Upvote 0
Thanks a ton venkat1926

The code works like charm :) and ddefinitely you are the person with wand..;)

Can you please also add the 2nd point which i have mentioned in my previous post

1) For e.g Inside of Just filling the cell with colours can we also add Text in the cell -
2) The code should also check if the date in O2 is within 1 week past the actual date than it should also be filled with red. If its more than 1 week old than it should be left unfilled/blank
Click to expand...

Sorry for my bad English,I know I have messed up with my 2nd point so to elaborate I will use an example

Lets us assume that today's date is 03/10/2014 (dd/mm/yyyy) and there are 3 columns A, B, C. "A" is the column which is having dates (the column with which your codes work on). "B" is the column which contains text Blue, Yellow, Orange, Green etc. C is the column were we need the output.

[TABLE="class: grid, width: 0"]
<tbody>[TR]
[TD="align: center"]A[/TD]
[TD="align: center"]B[/TD]
[TD="align: center"]C[/TD]
[/TR]
[TR]
[TD]01/10/2014[/TD]
[TD]BLUE[/TD]
[TD]<output>[/TD]
[/TR]
[TR]
[TD]02/10/2014[/TD]
[TD]ORANGE[/TD]
[TD]<output>[/TD]
[/TR]
[TR]
[TD]03/10/2014[/TD]
[TD]GREEN[/TD]
[TD]<output>[/TD]
[/TR]
[TR]
[TD]04/10/2014[/TD]
[TD]YELLOW[/TD]
[TD]<output>[/TD]
[/TR]
</tbody>[/TABLE]


So if the date is previous date compared to actual date like 01/10/2014 & 02/10/2014 and if in "B" Column there is any text apart from "BLUE" than the output in "C" will be filled with colour red "Within a week" if the colour is "BLUE" the "C" column should be left blank

[TABLE="class: grid"]
<tbody>[TR]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[/TR]
[TR]
[TD]01/10/2014[/TD]
[TD]BLUE[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]02/10/2014[/TD]
[TD]ORANGE[/TD]
[TD]Within Week[/TD]
[/TR]
[TR]
[TD]03/10/2014[/TD]
[TD]GREEN[/TD]
[TD]Within Week[/TD]
[/TR]
[TR]
[TD]04/10/2014[/TD]
[TD]YELLOW[/TD]
[TD]Within Week[/TD]
[/TR]
</tbody>[/TABLE]

I hope i have not mess with the example
 
Upvote 0
the result of the macro is column C. if you want any change indicate in colum D

Sheet1

*BC
hdngBhdngC

<colgroup><col style="font-weight:bold; width:30px; "><col style="width:109.6px;"><col style="width:151.2px;"></colgroup><tbody>
[TD="bgcolor: #cacaca, align: center"]1[/TD]

[TD="bgcolor: #cacaca, align: center"]2[/TD]
[TD="align: right"]9/27/2014[/TD]
[TD="bgcolor: #ff0000"]within a week[/TD]

[TD="bgcolor: #cacaca, align: center"]3[/TD]
[TD="align: right"]9/28/2014[/TD]
[TD="bgcolor: #ff0000"]within a week[/TD]

[TD="bgcolor: #cacaca, align: center"]4[/TD]
[TD="align: right"]9/29/2014[/TD]
[TD="bgcolor: #ff0000"]within a week[/TD]

[TD="bgcolor: #cacaca, align: center"]5[/TD]
[TD="align: right"]9/30/2014[/TD]
[TD="bgcolor: #ff0000"]within a week[/TD]

[TD="bgcolor: #cacaca, align: center"]6[/TD]
[TD="align: right"]10/1/2014[/TD]
[TD="bgcolor: #ff0000"]within a week[/TD]

[TD="bgcolor: #cacaca, align: center"]7[/TD]
[TD="align: right"]10/2/2014[/TD]
[TD="bgcolor: #ff0000"]within a week[/TD]

[TD="bgcolor: #cacaca, align: center"]8[/TD]
[TD="align: right"]10/3/2014[/TD]
[TD="bgcolor: #ff0000"]within a week[/TD]

[TD="bgcolor: #cacaca, align: center"]9[/TD]
[TD="align: right"]10/4/2014[/TD]
[TD="bgcolor: #ff0000"]within a week[/TD]

[TD="bgcolor: #cacaca, align: center"]10[/TD]
[TD="align: right"]10/5/2014[/TD]
[TD="bgcolor: #ff0000"]within a week[/TD]

[TD="bgcolor: #cacaca, align: center"]11[/TD]
[TD="align: right"]10/6/2014[/TD]
[TD="bgcolor: #ff0000"]within a week[/TD]

[TD="bgcolor: #cacaca, align: center"]12[/TD]
[TD="align: right"]10/7/2014[/TD]
[TD="bgcolor: #ff0000"]within a week[/TD]

[TD="bgcolor: #cacaca, align: center"]13[/TD]
[TD="align: right"]10/8/2014[/TD]
[TD="bgcolor: #ff0000"]within a week[/TD]

[TD="bgcolor: #cacaca, align: center"]14[/TD]
[TD="align: right"]10/9/2014[/TD]
[TD="bgcolor: #ff0000"]within a week[/TD]

[TD="bgcolor: #cacaca, align: center"]15[/TD]
[TD="align: right"]10/10/2014[/TD]
[TD="bgcolor: #ff0000"]within a week[/TD]

[TD="bgcolor: #cacaca, align: center"]16[/TD]
[TD="align: right"]10/11/2014[/TD]
[TD="bgcolor: #ff0000"]within a week[/TD]

[TD="bgcolor: #cacaca, align: center"]17[/TD]
[TD="align: right"]10/12/2014[/TD]
[TD="bgcolor: #ff0000"]within a week[/TD]

[TD="bgcolor: #cacaca, align: center"]18[/TD]
[TD="align: right"]10/13/2014[/TD]
[TD="bgcolor: #ffff00"]between 8 and 14[/TD]

[TD="bgcolor: #cacaca, align: center"]19[/TD]
[TD="align: right"]10/14/2014[/TD]
[TD="bgcolor: #ffff00"]between 8 and 14[/TD]

[TD="bgcolor: #cacaca, align: center"]20[/TD]
[TD="align: right"]10/15/2014[/TD]
[TD="bgcolor: #ffff00"]between 8 and 14[/TD]

[TD="bgcolor: #cacaca, align: center"]21[/TD]
[TD="align: right"]10/16/2014[/TD]
[TD="bgcolor: #ffff00"]between 8 and 14[/TD]

[TD="bgcolor: #cacaca, align: center"]22[/TD]
[TD="align: right"]10/17/2014[/TD]
[TD="bgcolor: #ffff00"]between 8 and 14[/TD]

[TD="bgcolor: #cacaca, align: center"]23[/TD]
[TD="align: right"]10/18/2014[/TD]
[TD="bgcolor: #ffff00"]between 8 and 14[/TD]

[TD="bgcolor: #cacaca, align: center"]24[/TD]
[TD="align: right"]10/19/2014[/TD]
[TD="bgcolor: #ffff00"]between 8 and 14[/TD]

[TD="bgcolor: #cacaca, align: center"]25[/TD]
[TD="align: right"]10/20/2014[/TD]
[TD="bgcolor: #00ff00"]between 15 and 21[/TD]

[TD="bgcolor: #cacaca, align: center"]26[/TD]
[TD="align: right"]10/21/2014[/TD]
[TD="bgcolor: #00ff00"]between 15 and 21[/TD]

[TD="bgcolor: #cacaca, align: center"]27[/TD]
[TD="align: right"]10/22/2014[/TD]
[TD="bgcolor: #00ff00"]between 15 and 21[/TD]

</tbody>


Excel tables to the web >> Excel Jeanie HTML 4
 
Upvote 0
Thanks for your instant replies (y)

can we restrict the past dates where we get comments from macro as "within a week" because if the date is 22-06-2014 than too it macro displays "within a week"

I mean will it be possible to restrict back dated entries to a week.

For eg

assuming today is 10-05-2014, so anything that is before 9/28/2014 in this case 09/27/2014 will be normal that is without red fill + no comments

[TABLE="class: cms_table"]
<tbody>[TR="bgcolor: #CACACA"]
[TD]*[/TD]
[TD]B[/TD]
[TD]C[/TD]
[/TR]
[TR]
[TD="bgcolor: #CACACA, align: center"]1[/TD]
[TD]hdngB[/TD]
[TD]hdngC[/TD]
[/TR]
[TR]
[TD="bgcolor: #CACACA, align: center"]2[/TD]
[TD="align: right"]9/27/2014[/TD]
[TD="bgcolor: #FF0000"][/TD]
[/TR]
[TR]
[TD="bgcolor: #CACACA, align: center"]3[/TD]
[TD="align: right"]9/28/2014[/TD]
[TD="bgcolor: #FF0000"]within a week[/TD]
[/TR]
[TR]
[TD="bgcolor: #CACACA, align: center"]4[/TD]
[TD="align: right"]9/29/2014[/TD]
[TD="bgcolor: #FF0000"]within a week[/TD]
[/TR]
[TR]
[TD="bgcolor: #CACACA, align: center"]5[/TD]
[TD="align: right"]9/30/2014[/TD]
[TD="bgcolor: #FF0000"]within a week[/TD]
[/TR]
[TR]
[TD="bgcolor: #CACACA, align: center"]6[/TD]
[TD="align: right"]10/1/2014[/TD]
[TD="bgcolor: #FF0000"]within a week[/TD]
[/TR]
[TR]
[TD="bgcolor: #CACACA, align: center"]7[/TD]
[TD="align: right"]10/2/2014[/TD]
[TD="bgcolor: #FF0000"]within a week[/TD]
[/TR]
[TR]
[TD="bgcolor: #CACACA, align: center"]8[/TD]
[TD="align: right"]10/3/2014[/TD]
[TD="bgcolor: #FF0000"]within a week[/TD]
[/TR]
[TR]
[TD="bgcolor: #CACACA, align: center"]9[/TD]
[TD="align: right"]10/4/2014[/TD]
[TD="bgcolor: #FF0000"]within a week[/TD]
[/TR]
[TR]
[TD="bgcolor: #CACACA, align: center"]10[/TD]
[TD="align: right"]10/5/2014[/TD]
[TD="bgcolor: #FF0000"]within a week[/TD]
[/TR]
[TR]
[TD="bgcolor: #CACACA, align: center"]11[/TD]
[TD="align: right"]10/6/2014[/TD]
[TD="bgcolor: #FF0000"]within a week[/TD]
[/TR]
[TR]
[TD="bgcolor: #CACACA, align: center"]12[/TD]
[TD="align: right"]10/7/2014[/TD]
[TD="bgcolor: #FF0000"]within a week[/TD]
[/TR]
[TR]
[TD="bgcolor: #CACACA, align: center"]13[/TD]
[TD="align: right"]10/8/2014[/TD]
[TD="bgcolor: #FF0000"]within a week[/TD]
[/TR]
[TR]
[TD="bgcolor: #CACACA, align: center"]14[/TD]
[TD="align: right"]10/9/2014[/TD]
[TD="bgcolor: #FF0000"]within a week[/TD]
[/TR]
[TR]
[TD="bgcolor: #CACACA, align: center"]15[/TD]
[TD="align: right"]10/10/2014[/TD]
[TD="bgcolor: #FF0000"]within a week[/TD]
[/TR]
[TR]
[TD="bgcolor: #CACACA, align: center"]16[/TD]
[TD="align: right"]10/11/2014[/TD]
[TD="bgcolor: #FF0000"]within a week[/TD]
[/TR]
[TR]
[TD="bgcolor: #CACACA, align: center"]17[/TD]
[TD="align: right"]10/12/2014[/TD]
[TD="bgcolor: #FF0000"]within a week[/TD]
[/TR]
[TR]
[TD="bgcolor: #CACACA, align: center"]18[/TD]
[TD="align: right"]10/13/2014[/TD]
[TD="bgcolor: #FFFF00"]between 8 and 14[/TD]
[/TR]
[TR]
[TD="bgcolor: #CACACA, align: center"]19[/TD]
[TD="align: right"]10/14/2014[/TD]
[TD="bgcolor: #FFFF00"]between 8 and 14[/TD]
[/TR]
[TR]
[TD="bgcolor: #CACACA, align: center"]20[/TD]
[TD="align: right"]10/15/2014[/TD]
[TD="bgcolor: #FFFF00"]between 8 and 14[/TD]
[/TR]
[TR]
[TD="bgcolor: #CACACA, align: center"]21[/TD]
[TD="align: right"]10/16/2014[/TD]
[TD="bgcolor: #FFFF00"]between 8 and 14[/TD]
[/TR]
[TR]
[TD="bgcolor: #CACACA, align: center"]22[/TD]
[TD="align: right"]10/17/2014[/TD]
[TD="bgcolor: #FFFF00"]between 8 and 14[/TD]
[/TR]
[TR]
[TD="bgcolor: #CACACA, align: center"]23[/TD]
[TD="align: right"]10/18/2014[/TD]
[TD="bgcolor: #FFFF00"]between 8 and 14[/TD]
[/TR]
[TR]
[TD="bgcolor: #CACACA, align: center"]24[/TD]
[TD="align: right"]10/19/2014[/TD]
[TD="bgcolor: #FFFF00"]between 8 and 14[/TD]
[/TR]
[TR]
[TD="bgcolor: #CACACA, align: center"]25[/TD]
[TD="align: right"]10/20/2014[/TD]
[TD="bgcolor: #00FF00"]between 15 and 21[/TD]
[/TR]
[TR]
[TD="bgcolor: #CACACA, align: center"]26[/TD]
[TD="align: right"]10/21/2014[/TD]
[TD="bgcolor: #00FF00"]between 15 and 21[/TD]
[/TR]
[TR]
[TD="bgcolor: #CACACA, align: center"]27[/TD]
[TD="align: right"]10/22/2014[/TD]
[TD="bgcolor: #00FF00"]between 15 and 21[/TD]
[/TR]
</tbody>[/TABLE]
Thanks in advance
 
Upvote 0
macro modified

first case is
"case is -7 to 7
you can adjust this to get what you want.

Code: 
Sub ColorCells()


   Dim rRange As Range
   Dim dToday As Date
   Dim numOfDays As Integer
   '================
   Worksheets("sheet1").Activate
   ActiveSheet.Columns("c:c").Cells.Clear
   '=================the above 2 codes are added to remove values and color.that is undo macro result
   '- this is whatever cell you have placed the first date in
   Set rRange = Range("B2")
   '- this is today's date
   dToday = Now
   
   '- a do loop that will step down the rows of the worksheet until
   '- it finds a blank cell
   Do While rRange.Text <> ""
      '- the number of days between today and the doc date
      '- NOTE: the "d" tells the DateDiff function to return the difference
      '-       in days
      numOfDays = DateDiff("d", dToday, rRange.Text)
      '- with blocks simply save typing... here it applies everywhere you see
      '- .Color (it really means rRange.Offset(ColumnOffset:=1).Interior.Color = vbRed
      With rRange.Offset(ColumnOffset:=1)
      
         '- i think the select statement is faster than a large if statement
         Select Case (numOfDays)
            '- if the doc date is within a week of today...
            Case -7 To 7
               '- ... make the color of the cell to the right red
               .Interior.Color = vbRed
               .Value = "within a week"
            '- two weeks
            Case 8 To 14
            
               '- ... yellow
               .Interior.Color = vbYellow
               .Value = "between 8 and 14"
            '- three weeks
            Case 15 To 21
               '- green (i used green, yellow, red because i did not find orange
               .Interior.Color = vbGreen
               .Value = "between 15 and 21"
         End Select
      End With
      '- now move to the next row below and repeat the loop
      Set rRange = rRange.Offset(RowOffset:=1)
   Loop








End Sub
 
Upvote 0
Thanks a lot venkat1926 .. it works like a charm

Just a quick question if a cell is blank in between it stops the code after that point.

Cant we keep the code range specific for eg "B2" to "B1000"
 
Upvote 0
slightly modified macro. need not restrict to B2: B1000. macro takes dynamic range. when because of macro rrange reached one after the last row the DO---LOOP stops and macro ends.

I tested the macro in this data.7th row is blank

Sheet1

*AB
hdngBhdngC
**

<tbody>
[TD="bgcolor: #cacaca, align: center"]1[/TD]

[TD="bgcolor: #cacaca, align: center"]2[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"]9/27/2014[/TD]

[TD="bgcolor: #cacaca, align: center"]3[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]9/28/2014[/TD]

[TD="bgcolor: #cacaca, align: center"]4[/TD]
[TD="align: right"]4[/TD]
[TD="align: right"]9/29/2014[/TD]

[TD="bgcolor: #cacaca, align: center"]5[/TD]
[TD="align: right"]5[/TD]
[TD="align: right"]9/30/2014[/TD]

[TD="bgcolor: #cacaca, align: center"]6[/TD]
[TD="align: right"]6[/TD]
[TD="align: right"]10/1/2014[/TD]

[TD="bgcolor: #cacaca, align: center"]7[/TD]

[TD="bgcolor: #cacaca, align: center"]8[/TD]
[TD="align: right"]8[/TD]
[TD="align: right"]10/3/2014[/TD]

[TD="bgcolor: #cacaca, align: center"]9[/TD]
[TD="align: right"]9[/TD]
[TD="align: right"]10/4/2014[/TD]

[TD="bgcolor: #cacaca, align: center"]10[/TD]
[TD="align: right"]10[/TD]
[TD="align: right"]10/5/2014[/TD]

[TD="bgcolor: #cacaca, align: center"]11[/TD]
[TD="align: right"]11[/TD]
[TD="align: right"]10/6/2014[/TD]

[TD="bgcolor: #cacaca, align: center"]12[/TD]
[TD="align: right"]12[/TD]
[TD="align: right"]10/7/2014[/TD]

[TD="bgcolor: #cacaca, align: center"]13[/TD]
[TD="align: right"]13[/TD]
[TD="align: right"]10/8/2014[/TD]

[TD="bgcolor: #cacaca, align: center"]14[/TD]
[TD="align: right"]14[/TD]
[TD="align: right"]10/9/2014[/TD]

[TD="bgcolor: #cacaca, align: center"]15[/TD]
[TD="align: right"]15[/TD]
[TD="align: right"]10/10/2014[/TD]

[TD="bgcolor: #cacaca, align: center"]16[/TD]
[TD="align: right"]16[/TD]
[TD="align: right"]10/11/2014[/TD]

[TD="bgcolor: #cacaca, align: center"]17[/TD]
[TD="align: right"]17[/TD]
[TD="align: right"]10/12/2014[/TD]

[TD="bgcolor: #cacaca, align: center"]18[/TD]
[TD="align: right"]18[/TD]
[TD="align: right"]10/13/2014[/TD]

[TD="bgcolor: #cacaca, align: center"]19[/TD]
[TD="align: right"]19[/TD]
[TD="align: right"]10/14/2014[/TD]

[TD="bgcolor: #cacaca, align: center"]20[/TD]
[TD="align: right"]20[/TD]
[TD="align: right"]10/15/2014[/TD]

[TD="bgcolor: #cacaca, align: center"]21[/TD]
[TD="align: right"]21[/TD]
[TD="align: right"]10/16/2014[/TD]

[TD="bgcolor: #cacaca, align: center"]22[/TD]
[TD="align: right"]22[/TD]
[TD="align: right"]10/17/2014[/TD]

[TD="bgcolor: #cacaca, align: center"]23[/TD]
[TD="align: right"]23[/TD]
[TD="align: right"]10/18/2014[/TD]

[TD="bgcolor: #cacaca, align: center"]24[/TD]
[TD="align: right"]24[/TD]
[TD="align: right"]10/19/2014[/TD]

[TD="bgcolor: #cacaca, align: center"]25[/TD]
[TD="align: right"]25[/TD]
[TD="align: right"]10/20/2014[/TD]

[TD="bgcolor: #cacaca, align: center"]26[/TD]
[TD="align: right"]26[/TD]
[TD="align: right"]10/21/2014[/TD]

[TD="bgcolor: #cacaca, align: center"]27[/TD]
[TD="align: right"]27[/TD]
[TD="align: right"]10/22/2014[/TD]

</tbody>


Excel tables to the web >> Excel Jeanie HTML 4


the modified macro is

Code: 
Sub ColorCells()






   Dim rRange As Range
   Dim dToday As Date
   Dim numOfDays As Integer
   '================
   Worksheets("sheet1").Activate
   ActiveSheet.Columns("c:c").Cells.Clear
   '=================the above 2 codes are added to remove values and color.that is undo macro result
   '- this is whatever cell you have placed the first date in
   Set rRange = Range("B2")
   '- this is today's date
   dToday = Now
   
   '- a do loop that will step down the rows of the worksheet until
   '- it finds a blank cell
   Do 'While rRange.Text <> ""
   If rRange = "" Then GoTo nextloop
   
      '- the number of days between today and the doc date
      '- NOTE: the "d" tells the DateDiff function to return the difference
      '-       in days
      numOfDays = DateDiff("d", dToday, rRange.Text)
      '- with blocks simply save typing... here it applies everywhere you see
      '- .Color (it really means rRange.Offset(ColumnOffset:=1).Interior.Color = vbRed
      With rRange.Offset(ColumnOffset:=1)
      
         '- i think the select statement is faster than a large if statement
         Select Case (numOfDays)
            '- if the doc date is within a week of today...
            Case -8 To 7
               '- ... make the color of the cell to the right red
               .Interior.Color = vbRed
               .Value = "within a week"
            '- two weeks
            Case 8 To 14
            
               '- ... yellow
               .Interior.Color = vbYellow
               .Value = "between 8 and 14"
            '- three weeks
            Case 15 To 21
               '- green (i used green, yellow, red because i did not find orange
               .Interior.Color = vbGreen
               .Value = "between 15 and 21"
         End Select
      End With
      '- now move to the next row below and repeat the loop
nextloop:
If rRange.Row > Cells(Rows.Count, "A").End(xlUp).Row Then Exit Do
      Set rRange = rRange.Offset(RowOffset:=1)
      
   Loop




MsgBox "macro done"


End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Solved
compare brands between two sheets and show minus and positive values based on date (today)
Replies
6
Views
279
abdo meghari
A
F
  • Question Question
VBA code giving error on line .Wrap = wdFindContinue
Replies
2
Views
1K
NdNoviceHlp
NdNoviceHlp
MrDB4Excel
  • Solved
Get the Correct Month
2
Replies
10
Views
278
Peter_SSs
Peter_SSs
E
  • Solved
If Formula
Replies
1
Views
434
ExceLoki
ExceLoki
M
  • Question Question
How can I make my conditional formatting macro format the correct columns in a pivot table?
Replies
0
Views
588
monuw
M

Share this page

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