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.
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.
I expect the student to do their homework and find all the errrors I leeve in.
Please take the time to read the Forum FAQ
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.
I expect the student to do their homework and find all the errrors I leeve in.
Please take the time to read the Forum FAQ
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...
The colours start to change ok but then I get a Run time error 1004. "Method intersect of object" _Global Failed.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
just inserted aat 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.Sheets("Main").Activate
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?
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
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 problemAlso, am I to comment out the "'This line is a deliberate error etc etc" ?
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
This will be a bit faster because it only calls ColorByPiority twice instead of for every cell.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
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
I expect the student to do their homework and find all the errrors I leeve in.
Please take the time to read the Forum FAQ
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
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...
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.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
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.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
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
I expect the student to do their homework and find all the errrors I leeve in.
Please take the time to read the Forum FAQ
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!!! 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
No!. Seriously, you don't want to do that. You wouldn't be able to see the words.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?
Check out this thread, Ontime vba opens another workbook that is not requested, It's anopther one with OnTime subs.
In modForce, remove the three lines with "SecondTme" in them, it is the Public Variable that prevents updating colors on book openingI'd like the date colours to update on workbook opening if possible.
I expect the student to do their homework and find all the errrors I leeve in.
Please take the time to read the Forum FAQ
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)2)If SecondTime = True ThenPublic SecondTime As Boolean
3)'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 theis present.wks.Protect Password:="123", UserInterfaceOnly:=True
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...
in the code belowTemp = Cells(Rw, TaskCol).Formula
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
I have so many versions, I don't remember which one you're using. Or even if I have what you have..Cells(Rw, BlankCol1).Interior.Color = [TimeColor|DateColor]
I expect the student to do their homework and find all the errrors I leeve in.
Please take the time to read the Forum FAQ
I inserted an sheet activate and it seems to have done the trick.
That said everything is working so far, so looks like I may have edited out the correct SecondTime lines.or s = LBound(VehicleSheets) To UBound(VehicleSheets) Set sht = Sheets(VehicleSheets(s)) sht.Activate UpdateColors sht Next s
Now all need to do is double check the Colour Logic/ Priority
Last edited by mexmike; 07-08-2015 at 03:27 PM.
Yes you are right, I have dozens now
My version
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?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
After the "End With"
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"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
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 :(
I expect the student to do their homework and find all the errrors I leeve in.
Please take the time to read the Forum FAQ
Absolutely totally Flabbergasted
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.
I expect the student to do their homework and find all the errrors I leeve in.
Please take the time to read the Forum FAQ