Macro for comparing dates and giving output as mentioned

[ninad_laud]

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

 

[ninad_laud]

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
hdngB	hdngC
*	*

<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

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

Getting error

Run-Time error '13':
Type Mismatch

 

[venkat1926]

it works for me. which code line gives error

 

[ninad_laud]

when i clicked on debug it showed me

[COLOR=#333333][I]numOfDays = DateDiff("d", dToday, rRange.Text)[/I][/COLOR]

 

[venkat1926]

hope dates start from 2nd row with firsts row containing headings.

the dates are in column B

send your data sheet please