Colour Entire Row Base on the Value of Two Other Cells

Are ya bored this holiday?
That Forceupdate colors won't work as is.

I now know how to make it work, but I'm still pondering the #38 attachment.

Take some holiday time and enjoy the celebration of the events of July 4, 1776.

This should do it. Obviously, you will have to do quite a bit of editing to put it in production.

I added to ability to click any vehicle sheets' Hours cell to activate the main sheets. corresponding cell for typing. ie, doubleclick the hours cell and type. Also, doubleclicking the Vehicle Reg cell on the main sheet, takes you to that Vehicle sheet.

When you close the book after editing, you will get an error because the CancelOntimes sub in modForce doesn't have an OnTime to cancel. Just End it.

Finally, If you click in cell A11 on each sheet and use the Windows menu >> Freeze Panes, the top of the sheet won't scroll out of sight.

More finally, please don't up;oad books that have been saved as "Read Only." My Excel v XP doesn't have that capability and I had to Save As new name all the time.

Hi SamT,

Just tried the new version. I like the double-click idea! but have some problems...

There appears to be a problem with the "colour updating" after main hour change or double click hours to next check. I update the hours and press enter, or double click the hours to next check, the message box pops up, I click ok and the cell selector cursor flashes blueish for a while. When it stops flashing, I find that the cell colours are unchanged. In sheet updating appears to work normally. Clearly the calculation is occurring but not providing the required colour output.

Unfortunately the code is above my brain cell grade, so can't quite figure out what's going on.

Also, am I to comment out the "'This line is a deliberate error etc etc" ?

Any ideas?

Many thanks as usual for all of your sterling efforts!!!

I thought that the sheets might need activating, so tried the following...

Code:

---

Private Sub Worksheet_Change(ByVal Target As Range)'Forces recoloring of sheet when vehicle hours are changed
  Select Case Target.Address
    Case "$H$6"
      Sheets("CD311").Activate
      Sheets("CD311").Calculate
      modForce.UpdateColors Sheets("CD311")
    Case "$H$8"
      Sheets("CD456").Activate
      Sheets("CD456").Calculate
      modForce.UpdateColors Sheets("CD456")
    Case "$H$10"
      Sheets("CD123").Activate
      Sheets("CD123").Calculate
      modForce.UpdateColors Sheets("CD123")
    Case "$H$12"
      Sheets("CD678").Activate
      Sheets("CD678").Calculate
      modForce.UpdateColors Sheets("CD678")
  End Select
End Sub

---

The colours start to change ok but then I get a Run time error 1004. "Method intersect of object" _Global Failed.

just inserted a

Code:

---

Sheets("Main").Activate

---

at the end of each modForce in the above code and the error has gone\, so I'll try a few combinations of hour inputs on the Main sheet to test all the sheets.

I have got the whole shibang integrated with my actual data and rolling but its very slow to update the colours after inputing hours on the main sheet and double click (30 seconds); probably because of having to unprotect and protect sheets.

Below is where I've stuck the unprotect statement.

Is there any way to speed things up?

Code:

---

Option ExplicitPublic Sub SetColors(sht As Worksheet, Cel As Range)


    Dim TimePriority As Long
    Dim DatePriority As Long
    Dim TaskPriority As Long
    Dim Rw As Long
    Dim i As Long
   
With sht
    Rw = Cel.Row
    ActiveSheet.Unprotect Password:="1234"
    TimePriority = PriorityHours(Cells(Rw, HoursRemainingCol))
    DatePriority = PriorityDays(Cells(Rw, DaysRemainingCol)) '<<<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 >= Priority4 Then .Bold = True Else .Bold = False
       
          End With
   
    ColoredHoursCells = Array("G", "I")
    For i = LBound(ColoredHoursCells) To UBound(ColoredHoursCells)
      .Rows(Rw).Columns(ColoredHoursCells(i)).Font.Color = ColorByPriority(TimePriority)
    Next i
    ColoredHoursCells = ""
   
    ColoredDaysCells = Array("N", "O")
    For i = LBound(ColoredDaysCells) To UBound(ColoredDaysCells)
      .Rows(Rw).Columns(ColoredDaysCells(i)).Font.Color = ColorByPriority(DatePriority)
    Next i
    ColoredDaysCells = ""
End With
ActiveSheet.Protect Password:="1234"
   
End Sub

---

Quote:

---

Also, am I to comment out the "'This line is a deliberate error etc etc" ?

---

Uh...Yeah. The Msgboxes are for debugging information only. ie, if you don't see "force Update Is Running. SecondTime is: something)" on the hour, that is a problem. If you don't see "Update Colors is running" on the hour and when you update Vehicle Hours on Sheet Main, that is a problem

The problems are totally my fault, I spread myself too thin this weekend and got burned out on VBA. Yours was the third or fourth (:Can't remember) good sized VBA project I worked on.

Really, you shouldn't need to Activate any sheet for this to work. The only reason for Acivating a sheet in the Main sheet's code is becaue you are moving to that sheet. BTW, on rethought, you probably want to remove the .Cells(TopMaintenanceRow... Select lines from that code. They force the sheet to scroll up to the top of the table. Not always what you want. BTW, if you Freeze Panes on Cell B11, the Task column will always be visible.

Doubleclicking the Vehicle Hours cell on a vehicle sheet shouldn't force a color update. It won't with the code below. It was triggering two separate Change events, not a "Good Thing!"

I see a brain fart in modForce. ForceUpdateColors; "TimeValue(DateAdd("h", 11, 0)), _" runs the code every 11 hours! Oops, Sorry. It should read "TimeValue(DateAdd("h", 1, 0)), _"

NOTE: THE ONLY WAY to test the code in this book is that after doing anything to it, you save and close the book, then reopen it and test the action on the sheets.

Try this "ThisWorkbook" code

Code:

---

Option Explicit
 

Private Sub Workbook_SheetChange(ByVal WkSht As Object, ByVal Target As Range)
Dim TrackChanges As Range
Set TrackChanges = Range(MaintenanceTable)
 
If WkSht Is Sheets("Main") Then Exit Sub
If Intersect(TrackChanges, Target) Is Nothing Then  Exit Sub

Application.EnableEvents = False
  modCellColoring.SetColors WkSht, Target
Application.EnableEvents = True

End Sub


Private Sub Workbook_Open()
Dim wks As Worksheet
    For Each wks In ThisWorkbook.Worksheets
        wks.Protect Password:="abc", UserInterfaceOnly:=True
    Next wks
   
  modForce.ForceUpdateColors
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
  'Starts the sub that cancels automatic update colors.
  modForce.CancelOntimes
End Sub

---

This will be a bit faster because it only calls ColorByPiority twice instead of for every cell.

Code:

---

Option Explicit

Public Sub SetColors(sht As Worksheet, Cel As Range)

    Dim TimePriority As Long
    Dim TimeColor As Long
    Dim DatePriority As Long
    Dim DateColor As Long
    Dim TaskColor As Long
    Dim Rw As Long
    Dim i As Long
   
With sht
    Rw = Cel.Row
    TimePriority = PriorityHours(Cells(Rw, HoursRemainingCol))
    DatePriority = PriorityDays(Cells(Rw, DaysRemainingCol)) '<<<Changed from your Sheet Code!!!!
   
    TimeColor = ColorByPriority(TimePriority)
    DateColor = ColorByPriority(DatePriority)
    TaskColor = TimeColor
    If TimePriority < DatePriority Then TaskColor = DateColor
   
    With .Cells(Rw, TaskCol).Font
        .Color = TaskColor
        .Bold = False
        If TaskPriority >= Priority3 Then .Bold = True
    End With
   
    ColoredHoursCells = Array("F", "G", "I")
    For i = LBound(ColoredHoursCells) To UBound(ColoredHoursCells)
      .Rows(Rw).Columns(ColoredHoursCells(i)).Font.Color = TimeColor
    Next i
   
    ColoredDaysCells = Array("N", "O")
    For i = LBound(ColoredDaysCells) To UBound(ColoredDaysCells)
      .Rows(Rw).Columns(ColoredDaysCells(i)).Font.Color = DateColor
    Next i
   
End With
End Sub

---

Ok I'm trying the code; many thanks!

I keep getting Debug errors because I have all of the sheets in the workbook protected to avoid inadvertent formula overwriting by mistaken keyboard input. When I remove the protection, the code runs quickly enough but I lose the formula security. I need to maintain this during manual sheet entry; Soooo, in order for the new code to run, I need to unprotected the sheets under the two different color update methods and reprotect them on completion without having time for a coffee in between. Too much caffeine keeps me up digging through this as it is:coffee::coffee::coffee:

1) Hour input from the Main page.
2) Manual update of each sheet by task etc

At present the code runs in about 5 seconds with protection in the following points...

Code:

---

Public Sub UpdateColors(sht As Worksheet)'Called by ForceUpdatecolors above and Main sheet Change vehicle hours
MsgBox "Update Colors is running"

ActiveSheet.Unprotect Password:="123"

Dim Rw As Long
Dim Temp As Variant

With sht
  For Rw = TopMaintenanceRow To Sheets(sht.Name).LastRow '? It works, I'm tired
    Temp = Cells(Rw, TaskCol).Formula
    Cells(Rw, TaskCol).Formula = Temp
    DoEvents
  Next Rw
End With

ActiveSheet.Protect Password:="123"

End Sub

---

This almost works and is still fast enough (relocks after main input); but as soon as I input a new task on any sheet, the whole sheet unlocks and formulas become vulnerable. I have tried different locations for the re-protection but the code then takes the plus 30 seconds to run.

Quote:

---

Soooo, in order for the new code to run, I need to unprotected the sheets under the two different color update methods and reprotect them on completion

---

Did you try this code for speed? I don't believe it's necessary, but you might have to unprotect the sheets manually, save the book, and reopen it.

Code:

---

Private Sub Workbook_Open()
    Dim wks As Worksheet
    For Each wks In ThisWorkbook.Worksheets
        wks.Protect Password:="123", UserInterfaceOnly:=True
    Next wks

modForce.ForceUpdateColors
End Sub

---

NNNNNNNarrrrgg!!! Seems to be working now

for some reason it didn't work th first time round. Probably because I didn't follow your instructions to the letter. Sorry!!! Couldn't find an egg on my face smiley!!! :p Hope the stupid frog face will do.

At first glances everything seems good to go. I'll do some more testing with live data and get back.

SamT you are an ace.

Many thanks.

Hi SamT,

This morning when opening the workbook, some of the dates that should now be red remained yellow. I'd like the date colours to update on workbook opening if possible. Do I need to disable part of the ForceUpdateColors? I'm not concerned with waiting a few extra seconds as it'll provide me with the correct colours for each case immediately.

Lastly, and please excuse me being a continuous pain, can I add some code to the SetColors to fill the cells in Column "D" to the same colour as the font of that row?

Cheers for the assist and I hope to very shortly be out of your hair, yeah right you say

Quote:

---

Lastly, and please excuse me being a continuous pain, can I add some code to the SetColors to fill the cells in Column "D" to the same colour as the font of that row?

---

No!. Seriously, you don't want to do that. You wouldn't be able to see the words.

Check out this thread, Ontime vba opens another workbook that is not requested, It's anopther one with OnTime subs.

Quote:

---

I'd like the date colours to update on workbook opening if possible.

---

In modForce, remove the three lines with "SecondTme" in them, it is the Public Variable that prevents updating colors on book opening

Hi SamT,

Ref wanting to colour fill column "D" the same as the font in column "A". This column contains no text i.e. empty, so I just want to fill each cell of that column with the same colour as the font adjacent to it in column "A" of the same row. It'll highlight the row more.

Sorry brains gone dead on the SecondTime instruction. I can see the following lines with "SecondTme"...

1)

Code:

---

If SecondTime = True Then

---

2)

Code:

---

Public SecondTime As Boolean

---

3)

Code:

---

'SecondTime = True 'Prevents updating colors on book open

---

I guess I'll have to remove the EndIf as well after the SecondTime?

Also once this is done, After the workbook opens, I get "Force Update is Running" once, followed by "UpdateColor is running" four times but it appears as though the only sheet that gets the colour is the last active sheet before the previous save. I believe this is password orientated even though the

Code:

---

wks.Protect Password:="123", UserInterfaceOnly:=True

---

is present.

Also, If I save and close the workbook from Main, when I reopen, I get a runtime error "'1004' Application defined or object defined" after the first Update colores is running and stop at line...

Code:

---

Temp = Cells(Rw, TaskCol).Formula

---

in the code below

Code:

---

With sht  For Rw = TopMaintenanceRow To Sheets(sht.Name).LastRow '? It works, I'm tired
    Temp = Cells(Rw, TaskCol).Formula
    Cells(Rw, TaskCol).Formula = Temp
    DoEvents
  Next Rw
End With

---

In modCellColoring.SetColors , after coloring the taskcolumn

Code:

---

.Cells(Rw, BlankCol1).Interior.Color = [TimeColor|DateColor]

---

I have so many versions, I don't remember which one you're using. Or even if I have what you have.

I inserted an sheet activate and it seems to have done the trick.

Code:

---

or s = LBound(VehicleSheets) To UBound(VehicleSheets)        Set sht = Sheets(VehicleSheets(s))
        sht.Activate
        UpdateColors sht
      Next s

---

That said everything is working so far, so looks like I may have edited out the correct SecondTime lines.

Now all need to do is double check the Colour Logic/ Priority

Yes you are right, I have dozens now
My version

Code:

---

Option Explicit
Public Sub SetColors(sht As Worksheet, Cel As Range)
   
    Dim TimePriority As Long
    Dim TimeColor As Long
    Dim DatePriority As Long
    Dim DateColor As Long
    Dim TaskColor As Long
    Dim TaskPriority As Long
    Dim Rw As Long
    Dim i As Long
   
           
    With sht
        Rw = Cel.Row
        TimePriority = PriorityHours(Cells(Rw, HoursRemainingCol))
        DatePriority = PriorityDays(Cells(Rw, DaysRemainingCol)) '<<<Changed from your Sheet Code!!!!
       
        TimeColor = ColorByPriority(TimePriority)
        DateColor = ColorByPriority(DatePriority)
        TaskColor = TimeColor
        If TimePriority < DatePriority Then TaskColor = DateColor
       
                             
        With .Cells(Rw, TaskCol).Font
            .Color = TaskColor
            .Bold = False
            .Cells(Rw, BLankCol1).Interior.Color = [TimeColor|DateColor]
 
'gives object does not support this property or method. Must go somewhere else!


            If TaskPriority >= Priority4 Then .Bold = True
           
        End With
       
        ColoredHoursCells = Array("G", "I")
        For i = LBound(ColoredHoursCells) To UBound(ColoredHoursCells)
            .Rows(Rw).Columns(ColoredHoursCells(i)).Font.Color = TimeColor
           
        Next i
       
        ColoredDaysCells = Array("N", "O")
        For i = LBound(ColoredDaysCells) To UBound(ColoredDaysCells)
            .Rows(Rw).Columns(ColoredDaysCells(i)).Font.Color = DateColor
        Next i
               
    End With
   
    '
   
End Sub

---

Not quite sure where to put it. The above location gives a run time error "object does not support this property or method" I guess because the line deals with font colour?

After the "End With"

Code:

---

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

          .Cells(Rw, BLankCol1).Interior.Color = TaskColor 'Adjust to suit

---

FYI, this is what your code says. Note that at the start of the sub, there is a "With Sht", and of course this section is inside a "With .Cells(Rw, TaskCol).Font"

Code:

---

Sht.Cells(Rw, TaskCol).Font.Color = TaskColor
Sht.Cells(Rw, TaskCol).Font.Bold = False
Sht.Cells(Rw, TaskCol).Font.Cells(Rw, BLankCol1).Interior.Color = TaskColor 'Adjust to suit. My bad instructions :(

---

Absolutely totally Flabbergasted :clap::clap::clap::friends::friends::friends::friends::beerchug::beerchug:: beerchug::beerchug::beerchug::beerchug::beerchug::beerchug::beerchug::beerc hug::beerchug::beerchug::beerchug::beerchug::beerchug::beerchug:

It's finished. All those beers are lined up for you at Cocorite, Port of Spain along with a big fat meal at the restaurant of your choice; no jokes. Your extreme patience is highly commendable and my thanks are little for the effort you have graciously afforded me.

Thanks SamT to you and all at vbaexpress.com and hope to see you soon!

If you really want to thank me, see my signature. PM me for details.

I don't think I will aver again travel the world.