Color Dates

HI,

The attached file/macro changes the cell color when run based on how many days in the past or future the date is from today. It currently uses calendar days and I need it to use workdays minus holidays.

The logic would be:

If the date in column A is more than 20 workdays days older than today, the cell color should be gray
If the date in column A is more than 5 workdays older than today but less than 21 days older than today, the cell color should be red
If the date in column A is today, the cell should be yellow
If the date in column A is today +1 workday, the cell should be dark green
if the date in column A is today + 2 workdays, the cell should be light green

Needs to be VBA, not conditional formatting.

Thanks in advance,

swjtx99
Date-Color.xls
swjtx99Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

ProfessorJimJamCommented:
you do not need a Macro or VBA for this.  we can achieve the same thing using formulas in condtional formatting.

if you would like the condtional formatting solution, let me know.
0
ProfessorJimJamCommented:
is your weekends always Saturday and Sunday?
0
ProfessorJimJamCommented:
ok though it would be much easier to do it with condtional formatting, but i am writing a VBA solution for you.

for example all you need to do is to put the followings in the condtional formatting
=IF(A2>WORKDAY.INTL(TODAY(),20,1,Holidays),TRUE)
=IF(AND(A2>WORKDAY.INTL(TODAY(),5,1,Holidays),A2<WORKDAY.INTL(TODAY(),21,1,Holidays)),TRUE)
=IF(A2=TODAY(),TRUE)
=IF(A2=WORKDAY.INTL(TODAY(),1,1,Holidays),TRUE)
=IF(A2=WORKDAY.INTL(TODAY(),2,1,Holidays),TRUE)

but before, that i noticed there is conflicting statement with your logics
for example your statement "If the date in column A is today, the cell should be yellow" return True if the A column has a date of today and then again the your other statement "If the date in column A is more than 20 workdays days older than today, the cell color should be gray" also return True for the same value "today's date" becuase today's date will always be smaller than 20 working days in advance.

just review your logic and see

the VBA is ready all you need to correct your logics , becuase the statement "If the date in column A is more than 20 workdays days older than today, the cell color should be gray" will return true for all of them.

i created a Holidays Array, you can add more and change the existing as per your name.

then only what is left is the wrong logic to be fixed.  so it is very easy to modify the If statement in the code below, if you tell me the correct non-conflicting logic then i can fix it for you. currently this code will change everything to gray becuase it return true in almost all of your logics.

Sub DateColor()



Dim C As Range
Dim CI As Integer
Dim Col As Variant
Dim FirstRow As Long
Dim Lastrow As Long
Dim rng As Range
Dim Wks As Worksheet
Dim monOffset As Integer
Dim aws As Worksheet
Dim nws As Worksheet
Dim cel As Range
Dim eror As Variant
Dim HolidaysList()

HolidaysList = Array("1/1/2014", "1/15/2014", "2/19/2014", "5/28/2014", "7/4/2014", "9/3/2014", "10/8/2014", "11/12/2014", _
"11/22/2014", "12/25/2014", "1/1/2015", "1/21/2015", "2/18/2015", "5/26/2015", "7/4/2015", "9/1/2015", "10/13/2015", _
"11/11/2015", "11/27/2015", "12/25/2015")

    Col = "A"
    FirstRow = 2   'Assumes header row is row 1
    Set Wks = Worksheets("Sheet1")
    Lastrow = Wks.Cells(Rows.Count, Col).End(xlUp).Row
    Lastrow = IIf(Lastrow < FirstRow, FirstRow, Lastrow)
    
    
   Set rng = Wks.Range(Cells(FirstRow, Col), Cells(Lastrow, Col))
      
    For Each C In rng
     If CLng(C.Value) = CLng(Date) Then C.Interior.ColorIndex = 6
     If CLng(C.Value) = Application.WorksheetFunction.WorkDay(CLng(Date), 1, HolidaysList) Then C.Interior.ColorIndex = 10
     If CLng(C.Value) = Application.WorksheetFunction.WorkDay(CLng(Date), 2, HolidaysList) Then C.Interior.ColorIndex = 4
     If CLng(C.Value) < Application.WorksheetFunction.WorkDay(CLng(Date), 20, HolidaysList) Then C.Interior.ColorIndex = 16
    If CLng(C.Value) < Application.WorksheetFunction.WorkDay(CLng(Date), 5, HolidaysList) And CLng(C.Value) > Application.WorksheetFunction.WorkDay(CLng(Date), 21, HolidaysList) Then C.Interior.ColorIndex = 3
    Next C

End Sub

Open in new window

0
Cloud Class® Course: SQL Server Core 2016

This course will introduce you to SQL Server Core 2016, as well as teach you about SSMS, data tools, installation, server configuration, using Management Studio, and writing and executing queries.

swjtx99Author Commented:
Hi ProfessorJimJam

Yes, it needs to be VBA.

Yes, weekends are always Saturday and Sunday.

Hmm. You're right, I mixed up the logic. I think this is a better way to describe:

If the date in column A is:

Today -21 or more workdays (-22, -23, -24 etc.) = Gray
Today -1 to -20 workdays = Red
Today = Yellow
Today + 1 workday = Dark Green
Today + 2 workdays = Light Green
Today > 2 workdays = No color

Does this make more sense? Sorry for the confusion.

Regards,

swjtx99
0
ProfessorJimJamCommented:
Hi Swjtx99,

here is the revised VBA to meet the condition as per your latest message.

Sub DateColor()

Dim C As Range
Dim CI As Integer
Dim Col As Variant
Dim FirstRow As Long
Dim Lastrow As Long
Dim rng As Range
Dim Wks As Worksheet
Dim monOffset As Integer
Dim aws As Worksheet
Dim nws As Worksheet
Dim cel As Range
Dim eror As Variant
Dim HolidaysList()

HolidaysList = Array("1/1/2014", "1/15/2014", "2/19/2014", "5/28/2014", "7/4/2014", "9/3/2014", "10/8/2014", "11/12/2014", _
"11/22/2014", "12/25/2014", "1/1/2015", "1/21/2015", "2/18/2015", "5/26/2015", "7/4/2015", "9/1/2015", "10/13/2015", _
"11/11/2015", "11/27/2015", "12/25/2015")

    Col = "A"
    FirstRow = 2   'Assumes header row is row 1
    Set Wks = Worksheets("Sheet1")
    Lastrow = Wks.Cells(Rows.Count, Col).End(xlUp).Row
    Lastrow = IIf(Lastrow < FirstRow, FirstRow, Lastrow)
    
    
   Set rng = Wks.Range(Cells(FirstRow, Col), Cells(Lastrow, Col))
      
    For Each C In rng
    
    If CLng(C.Value) <= Application.WorksheetFunction.WorkDay(CLng(Date), -21, HolidaysList) Then C.Interior.ColorIndex = 16
     If CLng(C.Value) <= Application.WorksheetFunction.WorkDay(CLng(Date), -1, HolidaysList) And CLng(C.Value) >= Application.WorksheetFunction.WorkDay(CLng(Date), -20, HolidaysList) Then C.Interior.ColorIndex = 3
     If CLng(C.Value) = CLng(Date) Then C.Interior.ColorIndex = 6
     If CLng(C.Value) = Application.WorksheetFunction.WorkDay(CLng(Date), 1, HolidaysList) Then C.Interior.ColorIndex = 10
     If CLng(C.Value) = Application.WorksheetFunction.WorkDay(CLng(Date), 2, HolidaysList) Then C.Interior.ColorIndex = 4
     If CLng(C.Value) > Application.WorksheetFunction.WorkDay(CLng(Date), 2, HolidaysList) Then C.Interior.ColorIndex = 0
   
    Next C

End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
swjtx99Author Commented:
Hi ProfessorJimJam,

Works great! Thank you very much for your time and assistance.

Regards,

swjtx99
0
ProfessorJimJamCommented:
You are welcome. Thanks for the feedback
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.