I have had another go at this.
The function required (which must be in a module, not on a worksheet or
ThisWorkbook code, is shown below
You then need to put it in a conditional format, in e1 you would put Formula
is =RunningOvertime(E2)>816
It has to have a range - in this case I have used E2 but it could be anything
- it is not used but with no range a conditional formula does not recalculate.
Then you apply Pattern Red and Bold as the format
then add a condition
=RunningOvertime(E2)>760 or whatever your warning level is and pattern orange
or something.
Then copy cell e1 and paste special formats to the other cells you want it to
apply to.
There is an issue however. If you use the function as I have shown it once
you pass a warning level that level will stay - even after another 17 weeks
have passed. Is that what you want? If not you will need to modify the
function so that it only looks at the latest 17 weeks. If you want to do that
remove the apostrophe at the beginning of the row
'FirstRow=endpoint
(this leaves some redundancy in the function but it will not noticeably slow
it down)
'Code start =====================
Option Explicit
Public Function RunningOvertime(rubbish As Range) As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim x As Long
Dim MyCol As Long
Dim NumWeeks As Integer
Dim MaxOt As Integer
Dim ThisOt As Integer
FirstRow = 2
Dim rangestart As Range
Dim rangeend As Range
LastRow = Worksheets("sheet1").UsedRange.Rows.Count
MyCol = Application.Caller.Column
NumWeeks = 17
MaxOt = 0
With Worksheets("Sheet1")
Dim endpoint As Long
endpoint = LastRow - NumWeeks + 1
'FirstRow=endpoint
For x = FirstRow To endpoint
Set rangestart = .Cells(x, MyCol)
Set rangeend = .Cells(x + NumWeeks, MyCol)
ThisOt = WorksheetFunction.Sum(.Range(rangestart, rangeend))
MaxOt = WorksheetFunction.Max(MaxOt, ThisOt)
Next x
End With
RunningOvertime = MaxOt
End Function
'Code end======================