Colour Entire Row Base on the Value of Two Other Cells

Hi,
I'm having problems with conditional formatting. Conditional Formatting using the built in Excel formatting seems to require very long formulas for what I wish to achieve. I was hoping to get help coding with VBA instead.
I have attached a more exact example of my problem. Basically I want to colour each row based on the values in row "G" and "O'. They can be Red, Green, Blue or Black.
Attachment 13806
Below is my Excel Conditional Format effort for most of the conditions but does not include the ISBLANK in most cases. I am hoping that VBA will be simpler.

Code:

---

=IF(AND(ISBLANK($G$11),ISBLANK($O$11)),TRUE,FALSE) 
=IF(AND(($G$11<=20),ISBLANK($O$11)),TRUE,FALSE)
=IF(AND(AND(($G$11>20),( $G$11<=50)),ISBLANK($O$11)),TRUE,FALSE)
=IF(AND(AND(($G$11>50),( $G$11<=100)),ISBLANK($O$11)),TRUE,FALSE)
=IF(AND(AND(($G$11>100)),ISBLANK($O$11)),TRUE,FALSE)
=IF(AND(ISBLANK($G$11),( $O$11<=7)),TRUE,FALSE)
=IF(AND(($G$11<=20),( $O$11<=7)),TRUE,FALSE)
=IF(AND($G$11>20, $G$11<=50, $O$11<=7),TRUE,FALSE)
=IF(AND($G$11>50, $G$11<=100, $O$11<=7),TRUE,FALSE)
=IF(AND($G$11>100, $O$11<=7),TRUE,FALSE)
=IF(AND(ISBLANK($G$11),( $O$11>7), $O$11<=30),TRUE,FALSE)
=IF(AND($G$11<=20, $O$11>7, $O$11<=30),TRUE,FALSE)
=IF(AND($G$11>20, $G$11<=50, $O$11<=30),TRUE,FALSE)
=IF(AND($G$11>50, $G$11<=100, $O$11>7, $O$11<=30),TRUE,FALSE)
=IF(AND($G$11>100, $O$11>7, $O$11<=30),TRUE,FALSE)
=IF(AND(ISBLANK($G$11),( $O$11>30), $O$11<=60),TRUE,FALSE)
=IF(AND($G$11<=20,$O$11>30, $O$11<=60),TRUE,FALSE)***
=IF(AND($G$11>20, $G$11<=50, $O$11>30, $O$11<=60),TRUE,FALSE)
=IF(AND($G$11>50, $G$11<=100, $O$11>30, $O$11<=60),TRUE,FALSE)
=IF(AND($G$11>100, $O$11>30, $O$11<=60),TRUE,FALSE)
=IF(AND(ISBLANK($G$11),( $O$11>60)),TRUE,FALSE)
=IF(AND(($G$11<=20),( $O$11>60)),TRUE,FALSE)
=IF(AND($G$11>20, $G$11<=50, $O$11>60),TRUE,FALSE)
=IF(AND(($G$11>100),( $O$11>60)),TRUE,FALSE)
=IF(AND($G$11>50, $G$11<=100, $O$11>60),TRUE,FALSE)

---

The columns with "TRUE" or "FALSE", only represent the formulas that I would use for the formatting. In reality they would be TASK's i.e. "Replace Oil Filter"

Many Thanks in Advance

If you were to attach a workbook, I'm sure it would be a whole lot easier for members to understand the concept. At the moment you have 25 IF statements and no indication of which cells they apply too.

Sorry, i didn't realise I could upload an Excel file. That's why there was only an image in my last post. I hope this attached file helps to explain my problem.
I realise the code I have posted is for the Excel Conditional Formatting and would really prefer to go to VBA if possible.

Thanks for any help in advance.

I'm still struggling to follow the logic of the data you have provided. One of the guidelines in your workbook suggests that you are seeking to colour a target line based on the amount of time left to complete a task, yet it somewhat difficult to work within the data.

For example, What's the relationship between the Days and Hours data? Within the first few rows you have nil days but 20 hrs = Red, 21 hrs = Green, 100 hrs = Blue, & 101 hrs = Black If everything was converted to hours then a simple Case Select could be used.

Next example, a few rows further down all have 7 days allocated but the hours vary between blank & 101hrs. Which is the more determine data?

If this was my worksheet, I'd convert all time (Days & Hours) to one common format, then I have an auto sort each time the workbook was opened, ranking all tasks from minimum to maximum time frames. At the moment this is far more complicated than necessary

Correct this please.

Hours=0,Days=0	BLACK
Hours<=20,Days=0	RED
Hours>20, <=50,Days=0	GREEN
Hours>50, <=100,Days=0	BLUE
Hours>100,Days=0	BLACK
Hours=0, Days<=7	RED
Hours<=20, Days<=7	RED
Hours>20, <=50, Days<=7	RED
Hours>50, <=100, Days<=7	RED
Hours>100, Days<=7	RED
Hours=0, Days>7,<=30	GREEN
Hours<=20, Days>7,<=30	RED
Hours>20, <=50, Days>7,<=30
Hours>50, <=100, Days>7,<=30	GREEN
Hours>100, Days>7,<=30	GREEN
Hours=0, Days>30,<=60	BLUE
Hours<=20,Days>30, <=60	RED
Hours>20, <=50, Days>30,<=60	GREEN
Hours>50, <=100, Days>30,<=60	BLUE
Hours>100, Days>30,<=60	BLUE
Hours=0, Days>60	BLACK
Hours<=20, Days>60	RED
Hours>20, <=50, Days>60	GREEN
Hours>50, <=100, Days>60	BLUE
Hours>100, Days>60	BLACK

Code:

---

Select Case Hours + (Days * 24)
Case 0: Tint = Black
Etc
End Select
Cell.Interior.Color  = Tint

---

A CF formula can't look like:

Code:

---

=IF(AND(ISBLANK($G$11),ISBLANK($O$11)),TRUE,FALSE)

---

but only

Code:

---

=AND(ISBLANK($G$11),ISBLANK($O$11))

---

Hi and thanks for the kind help.

I've uploaded a modified spreadsheet that will hopefully explain what I'm trying, rather in vain, to achieve.

There are comments above the Columns which may clarify things. You will see that the only important Columns are the TASK column "A" , the HOURS column "G" and the DAYS column "O". All the other columns are to help me understand where I am and try to get my head around the problem. An important point to note is that HOURS are "running hours" not calendar hours.

snb.
Thanks for correcting my incorrect CF formula. I really do not want to use CF in Excel but rather VBA. The CF formulas where my first attempt at resolving my problem but I soon started to get lost when trying to apply them. If you change any of the values in the sample date HOURS or DAYS column, the cells do change TRUE and FALSE.

I hope this brings a little more clarity to my request.
Thanks again.

In your latest book, the colors of the tasks are not dependent on hours or days, (See A21, A26)

You have positive hours and negative Days. WTF? (see A16, A21, )

Your notes say that these are hours and days " Remaining to the associated TASK." But you have a situation (Row 12) where the task is 100 hours overdue, but there are 60 days remaining. On the other hand (Row 21) the task has 21 hours remaining, even though it is 2 days overdue.

But at least now we can see that there are two sets of color rules

Hours IsEmpty	Black
Hours<=20	Red
Hours<=50	Green
Hours <=100	Blue
Else (> 100)	Black

Days IsEmpty	Black
Days <= 7	Red
Days <=30	Green
Days <=60	Blue
Else (>60)	Black

Quote:

---

Since you want the Task colored according the which time frame has the highest priority (Days = 5 is higher priority than hours = 21)

---

Is that right? I won't continue coding until I know.

Why not use 24 hour ranges for the hours, ie, 24, 48, and 96, instead of 20, 50, and 100?

cross posted very similar/same at:
http://www.ozgrid.com/forum/showthre...=195358&page=2
http://www.excelguru.ca/forums/showt...in-Two-Columns

Hi SamT, Logic for my Colours are as follows:

HOURS
RED <=20 Less than or equal to 20
GREEN >20<=50 Greater than 20 and less than or equal to 50
BLUE >50<=100 Greater than 50 and less than or equal to 100
BLACK >100 Greater than 100
BLACK ISEMPTY just for logic

DAYS
RED <=7 Less than or equal to 7
GREEN >7<=30 Greater than 7 and less than or equal to 30
BLUE >30<=60 Greater than 30 and less than or equal to 60
BLACK >60 Greater than 60
BLACK ISEMPTY just for logic.

I plan to Autofilter tasks based on HOURS and then tasks based on DAYS to help me decide which order to carry out work.

HOURS (running hours not calendar. If the vehicle is not in use no hours accumulated)

Negative numbers indicates a vehicle has missed an inspection and run over either running hours or calendar date because the operator didn't bring it in for maintenance due to negligence or the maintainer did not pay attention to this spreadsheet.

Some tasks have both running time and calendar limits. The important thing is that an inspection that has just gone RED will fall soon, even though the same task based on calendar may be BLUE and not yet due. It's a case of whichever comes first, hours running time or days.

I hope this helps explain and many thanks for your time.

Please excuse my ignorance regarding cross posting. I guess I have not read posting rules thoroughly enough.

Now it makes sense. Do you want Tasks, Hours and Days colored?

Hi SamT,
It would be great if that was possible. I would colour each according to their current status.
Thanks for the assistance.

The Functions in Module1 are pretty generic, they don't care where the cell is. I set up the code structure so that it is easy to add a priority level, if, for instance, you decide that what is red should be yellow and negative numbers should be Red.

The code in sheet1:

If you ever change the layout of your Tasks sheet, be sure that the Constants at the top of the code match the new column layout.

The Worksheet_change Sub: If you don't understand the comments, ask, I am not always clear in my instructions.

The SetColors Sub: It works, should'nt need to mess with it. Except, I added a fillip at the very bottom to set the Font in the Tasks Column to Bold, if it was Red. You can't miss it. If you don't like it, just comment out that IF...Then line.

The SetColorsManually Sub is only needed when your Tasks sheet has never had it's colors set or when the whole thing needs updating. To run it, place the mouse cursor inside the sub and press F5.

Module1 Code

Code:

---

Option Explicit

Enum Priorities
  Priority0
  Priority1
  Priority2
  Priority3
End Enum

---

Code:

---

Function PriorityDays(Cel As Range) As Long
    If Cel.Value = "" Then
    PriorityDays = Priority0
    Exit Function
  End If
 
Select Case Cel.Value
  Case Is <= 7: PriorityDays = Priority3
  Case Is <= 30: PriorityDays = Priority2
  Case Is <= 60: PriorityDays = Priority1
  Case Else: PriorityDays = Priority0
End Select
End Function

---

Code:

---

Function PriorityHours(Cel As Range) As Long
  If Cel.Value = "" Then
    PriorityHours = Priority0
    Exit Function
  End If
 
Select Case Cel.Value
  Case Is <= 20: PriorityHours = Priority3
  Case Is <= 50: PriorityHours = Priority2
  Case Is <= 100: PriorityHours = Priority1
  Case Else: PriorityHours = Priority0
End Select
End Function

---

Code:

---

Function ColorByPriority(priority As Long) As Long
  Select Case priority
    Case 0: ColorByPriority = vbBlack
    Case 1: ColorByPriority = vbBlue
    Case 2: ColorByPriority = vbGreen
    Case 3: ColorByPriority = vbRed
  End Select
End Function

---

Sheet1 Code

Code:

---

Option Explicit

'Edit all to suit
Const TaskCol As Long = 1
Const HoursCol As Long = 7
Const DaysCol As Long = 15

---

Code:

---


Private Sub Worksheet_Change(ByVal Target As Range)
Dim TrackChanges As Range

'TrackChanges must be set to those ranges that are manually changed.
'If the values in Days and Hours Remaining  are the result of formulas, then
'define these ranges as the locations where the new values of the
'formula precedents are entered
Set TrackChanges = Range(Range(Cells(11, TaskCol), Cells(10000, TaskCol)). _
                        Range(Cells(11, HoursCol), Cells(10000, HoursCol)), _
                        Range(Cells(11, DaysCol), Cells(10000, DaysCol)))
If Intersect(TrackChanges, Target) Is Nothing Then Exit Sub

SetColors Target
   
End Sub

---

Code:

---

Private Sub SetColors(Cel As Range)
Dim TimePriority As Long
Dim DatePriority As Long
Dim TaskPriority As Long
Dim Rw As Long

Rw = Cel.Row
TimePriority = PriorityHours(Cells(Rw, HoursCol))
Cells(Rw, HoursCol).Font.Color = ColorByPriority(TimePriority)

DatePriority = PriorityHours(Cells(Rw, DaysCol))
Cells(Rw, DaysCol).Font.Color = ColorByPriority(DatePriority)

If DatePriority > TimePriority Then
 TaskPriority = DatePriority
Else
 TaskPriority = TimePriority
End If

With Cells(Rw, TaskCol).Font
  .Color = ColorByPriority(TaskPriority)
  .Bold = False
  If TaskPriority = Priority3 Then .Bold = True
End With

End Sub

---

Code:

---



'Run once to set all tasks
Private Sub SetColorsManually()
Dim Cel As Range
For Each Cel In Range("A11:A" & Cells(Rows.Count, 1).End(xlUp).Row)
  SetColors Cel
Next Cel
End Sub

---

I'd use:

Daypriority

Code:

---

="priority "&CHOOSE(MATCH(INT(TODAY()-A12);{-1;0;7;30;60;90};1);"red";"orange";"blue";"green";"yellow";"black")

---

Hourpriority

Code:

---

"hourpriority "&choose(MATCH(24*(C1-MOD(NOW();1));{-1;0;20;50;100;120};1);"red";"orange";"blue";"green";"yellow";"black")

---

Dear SamT,

Amazing work. I'm quite speechless at your effort. Cleary I would have spent the next half century trying to achieve this result.

Many many thanks.

Snb, Many thanks also for your input, now that have an idea of what's involved, I'll try your suggestions as well.

Once again. Many many thanks to all. Very inspiring and extremely educational.

Kind Regards.

Hi SamT and snb,

I followed your advice regarding the negative numbers by adding a Case; worked a treat!
Also, I changed from the vbgreen to

Code:

---

Case 2: ColorByPriority = RGB(32, 148, 68)

---

as the vbgreen colour is a little too bright.

I had integrated your code into my working spreadsheets, which are way more complex than my example spreadsheet, expecting trouble as they already have VBA code. Guess what not a single problem. Everything worked exactly as advertised. Also, as you quite rightly state, it is quite universal and can be applied to a wide range of spreadsheets not just my application.

Great work, really! I owe you a beer or three when you next come through Trinidad where I'm based.

:beerchug:

Thanks for offering to clarify comments that you made in your coding.

Regarding this; I do use formulas to calculate hours and days remaining but do not understand, due to ignorance'...
"If the values in Days and Hours Remaining are the result of formulas, then'define these ranges as the locations where the new values of the formula precedents are entered".
My Days remaining formula, is based on a cell with

Code:

---

=NOW()

---

, periodicity in days and date last completed.
HOURS remaining comes from a formula based on single cell with current total vehicle hours, hours at which an inspection was completed and periodicity at which an inspection occurs i.e. Oil change 200 Hours, done at 789 hours. I update the total vehicle hours each day and of course, the calendar rolls by on it's own, so no need to input the date each day.


Also, my TASKS are selected from a drop down list on each row "A". Once I pick a new task and add periodicity for HOURS and DAYS, and hours and date completed at etc , I'd like the individual row colours to update at that time if possible.

These final details would allow me to not go into VBA to update the colours as new TASKS are entered onto the sheet.

Once again thank you for your kind assistance.

This is the code where the procedure is Triggered

Code:

---

Set TrackChanges = Range(Range(Cells(11, TaskCol), Cells(10000, TaskCol)), _
    Range(Cells(11, HoursCol), Cells(10000, HoursCol)), _
    Range(Cells(11, DaysCol), Cells(10000, DaysCol)))
 If Intersect(TrackChanges, Target) Is Nothing Then Exit Sub

---

Taking it line by line
the first part "Set TrackChanges = Range" is the Assignment.

This line defines the range that is the top 10000 rows of column A, (Column number 1.) Note that it is a Range from one Cell to the next. The Space Underscore at the end is the Line Continuation code.

Code:

---

(Range(Cells(11, TaskCol), Cells(10000, TaskCol)), _

---

The next Line Defines the Hours column. Like all three Range definitions, it uses predefined Constants for the column Number. You can use the Column Letter(s) String in place of the Column Number. (Cells(11, "H"),) Using the Column Number is just my style. The third line is the same for the Days column

Code:

---

Range(Cells(11, HoursCol), Cells(10000, HoursCol)), _

---

the final line say that if the changed cell was not in the Defined Range "TrackChanges," then Don't run the sub anymore.

Code:

---

If Intersect(TrackChanges, Target) Is Nothing Then Exit Sub

---

Right now the Procedure will only be run when you add a new Task, which is before the Remaining Days and hours are present. Not good.

Quote:

---

Once I ... add periodicity for HOURS and DAYS, and hours and date completed at etc , I'd like the individual row colours to update at ... [those Events] if possible.

---

I anticipated this, that is why the Sub SetColors only uses the Cell Row. Any Cell can be used as a trigger as long as it is in the same Row as the Task. At different times you will be making two changes at the same time. This will trigger the procedure at each change. The "EnableEvnts" mentioned in some code below will keep this from being a problem.

In the Sheet Code:
Remove these lines

Code:

---

'Edit all to suit
Const TaskCol As Long = 1
Const HoursCol As Long = 7
Const DaysCol As Long = 15

---

and Replace them with these. Put the appropriate column letters in between the quote marks.

Code:

---

'edit all to suit
Const HoursPeriodCol As String = ""
Const DaysPeriodCol As String = ""
Const TimeCompleteCol As String = ""
Const DateCompleteCol As String = ""

---

In the Worksheet_change sub, Replace these lines"

Code:

---

    Set TrackChanges = Range(Range(Cells(11, TaskCol), Cells(10000, TaskCol)), _
    Range(Cells(11, HoursCol), Cells(10000, HoursCol)), _
    Range(Cells(11, DaysCol), Cells(10000, DaysCol)))
    If Intersect(TrackChanges, Target) Is Nothing Then Exit Sub
   
    SetColors Target

---

With these lines. If you get errorrs, first look for typos. I am famuose for them.

Code:

---

    Set TrackChanges = Range(Range(Cells(11, DaysPeriodCol), Cells(10000, DaysPeriodCol)). _
    Range(Cells(11, HoursPeriodCol), Cells(10000, HoursPeriodCol)), _
    Range(Cells(11, TimeCompleteCol), Cells(10000, TimeCompleteCol)), _
    Range(Cells(11, DateCompleteCol), Cells(10000, dateCompleteCol)))

    If Intersect(TrackChanges, Target) Is Nothing Then Exit Sub
   
Application.EnableEvents = False
    SetColors Target
Application.EnableEvents = True

---

These changes means that the procedure will no longer change when you change a task. But then it doesn't need to, does it?

Ok, done but I'm getting Compile error. "Wrong number of arguments or invalid property assignment" at the bolded Range as below. spelling looks good.

Code:

---

Option Explicit

'edit all to suit
Const HoursPeriodCol As String = "C"
Const DaysPeriodCol As String = "L"
Const TimeCompleteCol As String = "E"
Const DateCompleteCol As String = "M"

Private Sub Worksheet_Change(ByVal Target As Range)
Dim TrackChanges As Range


'TrackChanges must be set to those ranges that are manually changed.
'If the values in Days and Hours Remaining  are the result of formulas, then
'define these ranges as the locations where the new values of the
'formula precedents are entered


Set TrackChanges = Range(Range(Cells(11, DaysPeriodCol), Cells(10000, DaysPeriodCol)). _
Range(Cells(11, HoursPeriodCol), Cells(10000, HoursPeriodCol)), _
Range(Cells(11, TimeCompleteCol), Cells(10000, TimeCompleteCol)), _
Range(Cells(11, DateCompleteCol), Cells(10000, DateCompleteCol)))
 
If Intersect(TrackChanges, Target) Is Nothing Then Exit Sub
 
Application.EnableEvents = False
SetColors Target
Application.EnableEvents = True


   
End Sub

---

see that dot near the end of the first line. That is some artifact of the forum. I have removed it several times and replaced it with a comma, but it just keeps coming back.

In your workbook, replace that dot with a comma.

The CF approach:

Gooday SamT,

I have replaced the "." with the "," as recommended but still get the same error at the first Range in...

Code:

---

Set TrackChanges = Range(Range

---

My sheet code is as follows. Note there is a password unprotect statement in it (password removed)...

Code:

---

Option Explicit

'Edit all to suit
Const HoursPeriodCol As String = "C"
Const DaysPeriodCol As String = "L"
Const TimeCompleteCol As String = "E"
Const DateCompleteCol As String = "M"


Private Sub Worksheet_Change(ByVal Target As Range)
Dim TrackChanges As Range

'TrackChanges must be set to those ranges that are manually changed.
'If the values in Days and Hours Remaining  are the result of formulas, then
'define these ranges as the locations where the new values of the
'formula precedents are entered
Set TrackChanges = Range(Range(Cells(11, DaysPeriodCol), Cells(10000, DaysPeriodCol)), _
Range(Cells(11, HoursPeriodCol), Cells(10000, HoursPeriodCol)), _
Range(Cells(11, TimeCompleteCol), Cells(10000, TimeCompleteCol)), _
Range(Cells(11, DateCompleteCol), Cells(10000, DateCompleteCol)))
 
If Intersect(TrackChanges, Target) Is Nothing Then Exit Sub
 
Application.EnableEvents = False
SetColors Target
Application.EnableEvents = True


   
End Sub

Private Sub SetColors(Cel As Range)
Dim TimePriority As Long
Dim DatePriority As Long
Dim TaskPriority As Long
Dim Rw As Long


Rw = Cel.Row
TimePriority = PriorityHours(Cells(Rw, HoursCol))
Cells(Rw, HoursCol).Font.Color = ColorByPriority(TimePriority)

DatePriority = PriorityHours(Cells(Rw, DaysCol))
Cells(Rw, DaysCol).Font.Color = ColorByPriority(DatePriority)

If DatePriority > TimePriority Then
 TaskPriority = DatePriority
Else
 TaskPriority = TimePriority
End If

With Cells(Rw, TaskCol).Font
  .Color = ColorByPriority(TaskPriority)
  .Bold = False
  If TaskPriority = Priority3 Then .Bold = True
  If TaskPriority = Priority4 Then .Bold = True
 
 
End With

End Sub

'Run once to set all tasks
Private Sub SetColorsManually()
ActiveSheet.Unprotect Password:=""
Dim Cel As Range
For Each Cel In Range("A11:A" & Cells(Rows.Count, 1).End(xlUp).Row)
  SetColors Cel
Next Cel
ActiveSheet.Protect Password:=""
End Sub

---

Thanks

Have I told you that I hate typing because of typos? Days ago, I made that typo of putting a dot where a comma belonged. That dot hid a language error I made at the same time, and, unfortunately allowed the app to do its job, at least under very restricted circumstances. Obviously it failed when put in production. At least I was forced to get off my lazy butt and figured out what the Help file really meant. I won't make that mistake again

All it takes is to change one word. Where you see "Set TrackChanges = Range," make it "Set TrackChanges = Union."

:banghead: :crying::banghead: :crying::banghead: :crying::banghead: :crying::banghead: :crying::banghead: :crying::banghead: :crying::banghead: :crying::banghead: :crying::banghead: :crying:

Less chance for typos with:

Code:

---

Set R_1 = Union([C11:C10000], [E11:E10000], [L11:M10000])

---

Hi SamT,

Thanks for your last input. Don't be hard on yourself as your help is always greatly appreciated.

Did the union change but then got a “variable not defined” in snippet... “With Cells(Rw, TaskCol).Font” I redefined TaskCol As Long and it went away.

Now all I need, if possible, is to get the colours to update as data input changes from either myself or from the automatic date calculation i.e. the date calculation comes from Excel, so calendar counts down on its own.

Also, I would like columns “A”, “G”, “I”, “N” & “O” to be colour formatted, as they are the numbers I need to watch as well as the Task itself which also needs to be coloured.

I believe I may have to add the following constants for Hours Due and Days Remaining…

Code:

---

Const TaskCol As Long = 1
Const HoursRemainCol As String ="G"
Const HoursDueCol As String = "I"
Const DateDueCol As String = "N"
Const DaysRemainingCol As String = "O"
Const HoursPeriodCol As String = "C"
Const TimeCompleteCol As String = "E"
Const DaysPeriodCol As String = "L"
Const DateCompleteCol As String = "M"

---

I also get a variable not defined for "HoursCol". Should this be my new Const HoursRemainCol? or HoursPeriodCol?

Code:

---

Rw = Cel.RowTimePriority = PriorityHours(Cells(Rw, HoursCol))
Cells(Rw, HoursCol).Font.Color = ColorByPriority(TimePriority)


DatePriority = PriorityHours(Cells(Rw, DaysCol))
Cells(Rw, DaysCol).Font.Color = ColorByPriority(DatePriority)

---

Hope this is not too much of a pain. Phew! so many questions Sorry:banghead:

That's because I got rid of these lines

Code:

---

Const TaskCol As Long = 1
Const HoursCol As Long = 7
Const DaysCol As Long = 15

---

TaskCol can be a String = "A" to be consistent with the others
HoursCol = HoursRemaingCol
DaysCol = DaysRemainingCol.

Lets take theExisting SetColors Sub

Code:

---

Private Sub SetColors(Cel As Range)
    Dim TimePriority As Long
    Dim DatePriority As Long
    Dim TaskPriority As Long
    Dim Rw As Long
   
    Rw = Cel.Row
    TimePriority = PriorityHours(Cells(Rw, HoursCol))
    Cells(Rw, HoursCol).Font.Color = ColorByPriority(TimePriority)
   
    DatePriority = PriorityHours(Cells(Rw, DaysCol))
    Cells(Rw, DaysCol).Font.Color = ColorByPriority(DatePriority)
   
    If DatePriority > TimePriority Then
        TaskPriority = DatePriority
    Else
        TaskPriority = TimePriority
    End If
   
    With Cells(Rw, TaskCol).Font
        .Color = ColorByPriority(TaskPriority)
        .Bold = False
        If TaskPriority = Priority3 Then .Bold = True
        If TaskPriority = Priority4 Then .Bold = True
    End With
End Sub

---

And reorder the lines for clarity and add your new columns

Code:

---

Option Explicit

Const TaskCol As String = "A"
Const HoursPeriodCol As String = "C"
Const TimeCompleteCol As String = "E"
Const HoursRemainCol As String = "G"
Const HoursDueCol As String = "I"

Const DaysPeriodCol As String = "L"
Const DateCompleteCol As String = "M"
Const DateDueCol As String = "N"
Const DaysRemainingCol As String = "O"

Private Sub SetColors(Cel As Range)
    Dim TimePriority As Long
    Dim DatePriority As Long
    Dim TaskPriority As Long
    Dim Rw As Long
   
    Rw = Cel.Row
    TimePriority = PriorityHours(Cells(Rw, HoursCol))
    DatePriority = PriorityDays(Cells(Rw, DaysCol)) '<<<Changed from your Sheet Code!!!!
    TaskPriority = TimePriority
    If TaskPriority < DatePriority Then TaskPriority = DatePriority
   
    With Cells(Rw, TaskCol).Font
        .Color = ColorByPriority(TaskPriority)
        .Bold = False
        If TaskPriority >= Priority3 Then .Bold = True '<<<<Note Change
       
    End With
   
    'IMO, this layout is not only clearer, but I just copied one line 4 times
    '    and then changed one word in each new line
    Cells(Rw, HoursPeriodCol).Font.Color = ColorByPriority(TimePriority)
    Cells(Rw, TimeCompleteCol).Font.Color = ColorByPriority(TimePriority)
    Cells(Rw, HoursRemainCol).Font.Color = ColorByPriority(TimePriority)
    Cells(Rw, HoursDueCol).Font.Color = ColorByPriority(TimePriority)
   
    Cells(Rw, DaysPeriodCol).Font.Color = ColorByPriority(DatePriority)
    Cells(Rw, DateCompleteCol).Font.Color = ColorByPriority(DatePriority)
    Cells(Rw, DateDueCol).Font.Color = ColorByPriority(DatePriority)
    Cells(Rw, DaysRemainingCol).Font.Color = ColorByPriority(DatePriority)
    'See Constants above and compare this line to previous 4 lines
    'Range ("L" & Rw & ":O" & Rw).Font.Color = ColorByPriority(DatePriority)
    'IMO, use the Previous 4 for consistancy with first 4. YMMV
 
End Sub

---

Ok got that and have just integrated it into my sheet. I left "Set TrackChanges" with the corrections you mentioned and have given it a spin. Seems ok so far. I'll report back tomorrow once given a more thorough testing. my eyes knackered with all the concentration.

Many many thanks and Goodnight Good Knight.:hi:

Ok SamT,

That's it! I made a couple of alterarions to get one more column to change colour and everything is still tickety boo!
Your code and explanations have helped me to no end and the code is flexible enough for me to make any minor changes that I might need to make in the future.

That said, although I dont' undestand all of the code you kindly worked on, I've learnt a lot and will hopefully be more self sufficient VBA wise.

Cheers and Thanks again to you and all at VBAX.

Morning SamT,

Just come across a minor glitch which I hadn't noticed; Sorry!!!

I've just this morning opened up the spreadsheet and noticed that although the actual date has changed (all calendar items depend on this),

Code:

---

=NOW()

---

the colour of Days DaysRemainingCol and their related cells that also should have changed colour, are still the previous days colour, i.e. have not counted down in colour. So instead of having changed from yellow to red as the date rolled over from yesterday, they are still yellow. Everything else changes as advertised If I make an input change in that row.

The same pretty much applies to "vehicle hours" (all hour items depend on this), such that all the inspection tasks recalculate in the HoursRemainingCol. Their cells also do not automatically change colour unless I make a change in that row. My fault for not mentioning this when I first asked for help.:(

In each case, date and hours, all other calculations refer to these respective cells for carrying out the HoursRemainingCol and DaysRemainingCol calculations. Can you let me know how to include that into the code?

I think I may need to use something like...

Code:

---

Private Sub Worksheet_Calculate()

Dim target As Range
   
Set target = Range("E5")


If Not Intersect(target, Range("E5")) Is Nothing Then Exit Sub
 
Application.EnableEvents = False
SetColors target
Application.EnableEvents = True
   
End Sub

---

That does not appear to work though ("E5" is main hours). Also, I need to refer to cell "A4" =Now() as well, so am still stuck.
Hope you get my drift and as always thanks for the kind help.:bug:

These additions will update the colors when the workbook is opened and every hour 10 seconds after the hour until you close the book.

ThisWorkbook Code

Code:

---

Option Explicit

Private Sub Workbook_Open()
  RunForceUpdateColorsAgain = True
  ForceUpdateColors

End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
  RunForceUpdateColorsAgain = False
  ForceUpdateColors

End Sub

---

Module1 code
Add these lines under the End Enum

Code:

---

Dim RunForceUpdateColorsAgain As Boolean 'Value set in Workbook Open/Close subs
Dim RunForceUptateColorsTime As String

---

Add these two subs

Code:

---

Sub ForceUpdateColors()

  'Initialize time to run
  If RunForceUptateColorsTime = "" Then RunForceUptateColorsTime = Time
 
  'Set time to run to next exact hour + 10 seconds
  RunForceUptateColorsTime = Format(DateAdd("h", 1, RunForceUptateColorsTime), "h:00:10")
 
  Application.OnTime EarliestTime:=TimeValue(RunForceUptateColorsTime), _
    Procedure:="ForceUpdateColors", Schedule:=RunForceUpdateColorsAgain

  If RunForceUpdateColorsAgain Then UpdateColors

End Sub

Sub UpdateColors()
Const DateDueCol As String = "N"
Const RopRow As Long = 11
Const TaskSheet As String = "Insert the Tab name of the Worksheet here" '<<<<<<<<<<<<<<<
Dim BottomCell As Range
Dim Temp As Variant
Dim Cel As Range

With Sheets(TaskSheet)
  Set BottomCell = Cells(.Rows.Count, DateDueCol).End(xlUp)
  For Each Cel In Range(.Cells(TopRow, DateDueCol), BottomCell)
    Temp = Cel.Formula
    Cel.formula = Temp
    DoEvents 'To ensure updating each row.
  Next Cel
End With
End Sub

---

Hi SamT,

Sorry, but I need the colour to update each time I introduce the latest main vehicle hours. I have several vehicles and update the hours as soon as new values are known. If for example a lot of hours are accrued, it is important to see what is due immediately. I input the latest vehicle hours and the hours remaining to the next inspection changes immediately. I then open the vehicle tab that needs work and look at the colours of the inspections, as well as hours and days remaining to the next inspections and base the days work on that.

The vehicle hours input sheet only contains the most basic input output data without all the inspection details. The formulas in the individual rows of the inspection sheets calculate the time remaining and then returns the closest inspection due back to the input sheet. This allows me to prioritise which vehicle needs attention at a glance.

I've uploaded a copy of the top sheet where I update the vehicle hours. The current date "=Now()" is taken from this sheet for the date calculations on each vehicle sheet.

As usual many thank for you kind help.

Please upload the book with all the code in it and a complete schedule sheet. I don't keep any workbooks more than a few days and I haven't seen the changes you made to the code..

To All.

There is a fatal error in the UpdateColors sub above that I just corrected, so if anybody has tried it before now, please look at the new version above.

Sorry for any inconvenience.

Ok SamT,

Please see the attached file

I've included all the columns and sample data.

As you'll see, updating the sheet manually works fine but changing the current hours on sheet1 leaves the cell colours unchanged. Same applies as the date automatically rolls over.

As before, thanks for the amazing help:cool:

I got the attachment, but I am down for the night, C U tomorrow.

Please note that there are some gash formulas remaining in sheet2 that I forgot to delete before sending.

Also, you can see by sheet1, that there are normally 5 sheets in total; the input sheet and one for each vehicle.

Very Happy 4th of July to All:bigdance2

Just uploaded the workbook with the four vehicle sheets added

Hi SamT,

Hope your 4th of July is going swimmingly!

I have added macros to module2 that basically reference the SetColorsManually() sub that you coded for me. Changes to the target cells on sheet1 call that macro. This means the sheets update their colours every time I input vehicle running hours on sheet1, so thats good now.

For the manual row changes on each vehicle sheet, I was hoping to get a single set of code into a module that would cover all of the sheets but have not figured that out yet. So all the sheet code is still in each sheet code module (looks very clumsy but still works).

I still can't seem to get the automatic colour change when the date changes. I tried using your code but get a weird message that I can't remember something about incorrect blah blah!! but the following code gets highlighted if memory serves...

Code:

---

Application.OnTime EarliestTime:=TimeValue(RunForceUptateColorsTime), _
    Procedure:="ForceUpdateColors", Schedule:=RunForceUpdateColorsAgain

---

Boy is it hard to keep track of all the changes but at least it's turning into something usable for me.

Catch you later

I've just integrated the previously uploaded sheet with my actual working spreadsheet, which has other macros and formulas. It's like waiting for a kettle to boil for it to get back to the input sheet, after changing vehicle running hours:dunno