Macro for comparing dates and giving output as mentioned

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
 

Some videos you may like

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.

venkat1926

Well-known Member
Joined
Aug 21, 2005
Messages
4,824
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
 

ninad_laud

New Member
Joined
Oct 1, 2014
Messages
7
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

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
 

venkat1926

Well-known Member
Joined
Aug 21, 2005
Messages
4,824
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
 

ninad_laud

New Member
Joined
Oct 1, 2014
Messages
7

ADVERTISEMENT

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

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.

ABC
01/10/2014BLUE<output>
02/10/2014ORANGE<output>
03/10/2014GREEN<output>
04/10/2014YELLOW<output>

<tbody>
</tbody>


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

ABC
01/10/2014BLUE
02/10/2014ORANGEWithin Week
03/10/2014GREENWithin Week
04/10/2014YELLOWWithin Week

<tbody>
</tbody>

I hope i have not mess with the example
 

venkat1926

Well-known Member
Joined
Aug 21, 2005
Messages
4,824
the result of the macro is column C. if you want any change indicate in colum D

Sheet1

*BC
1hdngBhdngC
29/27/2014within a week
39/28/2014within a week
49/29/2014within a week
59/30/2014within a week
610/1/2014within a week
710/2/2014within a week
810/3/2014within a week
910/4/2014within a week
1010/5/2014within a week
1110/6/2014within a week
1210/7/2014within a week
1310/8/2014within a week
1410/9/2014within a week
1510/10/2014within a week
1610/11/2014within a week
1710/12/2014within a week
1810/13/2014between 8 and 14
1910/14/2014between 8 and 14
2010/15/2014between 8 and 14
2110/16/2014between 8 and 14
2210/17/2014between 8 and 14
2310/18/2014between 8 and 14
2410/19/2014between 8 and 14
2510/20/2014between 15 and 21
2610/21/2014between 15 and 21
2710/22/2014between 15 and 21

<colgroup><col style="font-weight:bold; width:30px; "><col style="width:109.6px;"><col style="width:151.2px;"></colgroup><tbody>
</tbody>


Excel tables to the web >> Excel Jeanie HTML 4
 

ninad_laud

New Member
Joined
Oct 1, 2014
Messages
7

ADVERTISEMENT

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

*BC
1hdngBhdngC
29/27/2014
39/28/2014within a week
49/29/2014within a week
59/30/2014within a week
610/1/2014within a week
710/2/2014within a week
810/3/2014within a week
910/4/2014within a week
1010/5/2014within a week
1110/6/2014within a week
1210/7/2014within a week
1310/8/2014within a week
1410/9/2014within a week
1510/10/2014within a week
1610/11/2014within a week
1710/12/2014within a week
1810/13/2014between 8 and 14
1910/14/2014between 8 and 14
2010/15/2014between 8 and 14
2110/16/2014between 8 and 14
2210/17/2014between 8 and 14
2310/18/2014between 8 and 14
2410/19/2014between 8 and 14
2510/20/2014between 15 and 21
2610/21/2014between 15 and 21
2710/22/2014between 15 and 21

<tbody>
</tbody>
Thanks in advance
 

venkat1926

Well-known Member
Joined
Aug 21, 2005
Messages
4,824
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
 

ninad_laud

New Member
Joined
Oct 1, 2014
Messages
7
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"
 

venkat1926

Well-known Member
Joined
Aug 21, 2005
Messages
4,824
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
1hdngBhdngC
229/27/2014
339/28/2014
449/29/2014
559/30/2014
6610/1/2014
7**
8810/3/2014
9910/4/2014
101010/5/2014
111110/6/2014
121210/7/2014
131310/8/2014
141410/9/2014
151510/10/2014
161610/11/2014
171710/12/2014
181810/13/2014
191910/14/2014
202010/15/2014
212110/16/2014
222210/17/2014
232310/18/2014
242410/19/2014
252510/20/2014
262610/21/2014
272710/22/2014

<tbody>
</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
 

Watch MrExcel Video

Forum statistics

Threads
1,108,924
Messages
5,525,661
Members
409,658
Latest member
Yardcell

This Week's Hot Topics

Top