Colour Entire Row Base on the Value of Two Other Cells

**mexmike** · 06-29-2015, 06:53 PM

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.

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

**SamT** · 06-29-2015, 07:22 PM

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.

**snb** · 06-30-2015, 12:19 AM

The CF approach:

**mexmike** · 06-30-2015, 05:07 AM

Gooday SamT,

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

Set TrackChanges = Range(Range

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

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

**SamT** · 06-30-2015, 06:22 AM

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."

**snb** · 06-30-2015, 06:48 AM

Less chance for typos with:

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

**mexmike** · 06-30-2015, 02:24 PM

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…

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?

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

**SamT** · 06-30-2015, 05:41 PM

That's because I got rid of these lines

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

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

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

**mexmike** · 06-30-2015, 06:44 PM

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.

**mexmike** · 07-01-2015, 12:47 PM

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.

**mexmike** · 07-02-2015, 05:29 PM

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),

=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...

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.

**SamT** · 07-02-2015, 08:51 PM

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

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

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

Add these two subs

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

**mexmike** · 07-03-2015, 03:49 PM

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.

**SamT** · 07-03-2015, 06:45 PM

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.

**mexmike** · 07-03-2015, 08:58 PM

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

**SamT** · 07-03-2015, 09:18 PM

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

**mexmike** · 07-04-2015, 06:34 AM

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

**mexmike** · 07-04-2015, 12:23 PM

Just uploaded the workbook with the four vehicle sheets added

**mexmike** · 07-04-2015, 04:02 PM

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...

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

**mexmike** · 07-04-2015, 07:08 PM

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

Thread: Colour Entire Row Base on the Value of Two Other Cells

Thread Tools

Display

Getting a Compile Error

Just integrated your updates. Looks good.

Latest Spreadsheet Update

Updated Workbook with Four Vehicles

Macros Added

Posting Permissions