Macro for comparing dates and giving output as mentioned

ninad_laud · Oct 1, 2014

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

venkat1926 · Oct 3, 2014

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 · Oct 3, 2014

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

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 · Oct 4, 2014

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 · Oct 4, 2014

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.

A	B	C
01/10/2014	BLUE	<output>
02/10/2014	ORANGE	<output>
03/10/2014	GREEN	<output>
04/10/2014	YELLOW	<output>

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

A	B	C
01/10/2014	BLUE
02/10/2014	ORANGE	Within Week
03/10/2014	GREEN	Within Week
04/10/2014	YELLOW	Within Week

I hope i have not mess with the example

venkat1926 · Oct 5, 2014

the result of the macro is column C. if you want any change indicate in colum D

Sheet1

*	B	C
1	hdngB	hdngC
2	9/27/2014	within a week
3	9/28/2014	within a week
4	9/29/2014	within a week
5	9/30/2014	within a week
6	10/1/2014	within a week
7	10/2/2014	within a week
8	10/3/2014	within a week
9	10/4/2014	within a week
10	10/5/2014	within a week
11	10/6/2014	within a week
12	10/7/2014	within a week
13	10/8/2014	within a week
14	10/9/2014	within a week
15	10/10/2014	within a week
16	10/11/2014	within a week
17	10/12/2014	within a week
18	10/13/2014	between 8 and 14
19	10/14/2014	between 8 and 14
20	10/15/2014	between 8 and 14
21	10/16/2014	between 8 and 14
22	10/17/2014	between 8 and 14
23	10/18/2014	between 8 and 14
24	10/19/2014	between 8 and 14
25	10/20/2014	between 15 and 21
26	10/21/2014	between 15 and 21
27	10/22/2014	between 15 and 21

Excel tables to the web >> Excel Jeanie HTML 4

ninad_laud · Oct 5, 2014

Thanks for your instant replies

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

*	B	C
1	hdngB	hdngC
2	9/27/2014
3	9/28/2014	within a week
4	9/29/2014	within a week
5	9/30/2014	within a week
6	10/1/2014	within a week
7	10/2/2014	within a week
8	10/3/2014	within a week
9	10/4/2014	within a week
10	10/5/2014	within a week
11	10/6/2014	within a week
12	10/7/2014	within a week
13	10/8/2014	within a week
14	10/9/2014	within a week
15	10/10/2014	within a week
16	10/11/2014	within a week
17	10/12/2014	within a week
18	10/13/2014	between 8 and 14
19	10/14/2014	between 8 and 14
20	10/15/2014	between 8 and 14
21	10/16/2014	between 8 and 14
22	10/17/2014	between 8 and 14
23	10/18/2014	between 8 and 14
24	10/19/2014	between 8 and 14
25	10/20/2014	between 15 and 21
26	10/21/2014	between 15 and 21
27	10/22/2014	between 15 and 21

Thanks in advance

venkat1926 · Oct 6, 2014

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 · Oct 8, 2014

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 · Oct 9, 2014

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

*	A	B
1	hdngB	hdngC
2	2	9/27/2014
3	3	9/28/2014
4	4	9/29/2014
5	5	9/30/2014
6	6	10/1/2014
7	*	*
8	8	10/3/2014
9	9	10/4/2014
10	10	10/5/2014
11	11	10/6/2014
12	12	10/7/2014
13	13	10/8/2014
14	14	10/9/2014
15	15	10/10/2014
16	16	10/11/2014
17	17	10/12/2014
18	18	10/13/2014
19	19	10/14/2014
20	20	10/15/2014
21	21	10/16/2014
22	22	10/17/2014
23	23	10/18/2014
24	24	10/19/2014
25	25	10/20/2014
26	26	10/21/2014
27	27	10/22/2014

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

Macro for comparing dates and giving output as mentioned

ninad_laud

New Member

Excel Facts

venkat1926

Well-known Member

ninad_laud

New Member

venkat1926

Well-known Member

ninad_laud

New Member

venkat1926

Well-known Member

ninad_laud

New Member

venkat1926

Well-known Member

ninad_laud

New Member

venkat1926

Well-known Member

Similar threads

Forum statistics

Share this page

Macro for comparing dates and giving output as mentioned

New Member

Excel Facts

Well-known Member

New Member

Well-known Member

New Member

Well-known Member

New Member

Well-known Member

New Member

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock