conditional formatting......................

I know i can do it with conditional formatting but i need more than
three thats why i posted in here Under ExcelVBA.

Sorry should have been more specific.

The formula for the conditional formatting in E2 will be

or(sum(E4:E20)>816,sum(E5:E21)>816,sum(E6:E22)>816)

Then copy this to cell g2 etc.
(might be easier to just use the extend handle and then replace what you
wanted in the intervening cells.)

or you could use

Max(sum(E4:E20),sum(E5:E21),sum(E6:E22))>816

It could also be done by VBA using a for loop which would avoid having to plug
in all the separate ranges (what is the last one for col E?)

Or you could write a vba fiunction and use that in the conditional format.
That is probably the method I would use if there were many ranges.

I have done it with conditional formatting and some othe calcs to other cells.

Using a VBA routine will just be cleaner.

The cell i want to highlight has the employees name in it so that if his
overtime goes above 816 for any rolling 17 week period it goes turns red.

So all i need is the code that will look at the range E4:E20 and if the sum of
these exceeds 816 then colour cell E2 Red.

I also need it to turn the E2 orange when it reaches 780 (a kind of pre warning
traffic light thing)

I'm still learning VBA and have done some cool thing with it but i can't get my
head round how to do this.

I wrote a function that calculates the max worked over any 17 week period but
when I put it in the worksheet it would only calculate when edited.

It was in a module.


I do not know what is going wrong. When I put it in a conditional format it
did nothing.

There's WAY to many questions to try to write the whole thing
for you!
Like:
Are the most recent hours at the bottom? or top?
What is the maximum number of rows? columns?
Are you wanting to change the TEXT color, or CELL color?

We can come up with coding to FIND the last rows/columns, but
if these are fixed, I'm just wasting my time  (but you'd be learning, so
it's not a total  loss).

Here's a couple of tips to try to help with the self-taught approach:
Begin recording a macro and change the text or background color.
This will give you the color numbers you will need later.

In the VBA editor, on the sheet tab, create an Event
called "Worksheet_Change":
'--------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
CalcTime
End Sub
'--------------------------------------------------------
Then, in a module, create the CalcTime subroutine:
'--------------------------------------------------------
Option Explicit
Dim EmpCol, DateRow
Dim MaxEmp, MaxRow, StartEmpCol, StartRow
Dim WarnHrs, MaxHrs, SubTTl
Dim X, Y, Warnflag

Sub CalcTime()
'Loop through Employees
Application.EnableEvents = False
MaxEmp = 14
MaxRow = 80
StartEmpCol = 2
StartRow = 4
WarnHrs = 780
MaxHrs = 816

'Clear warnings
Cells.Interior.ColorIndex = xlNone

Range("A1").Select
'----------------------------------------
For X = StartEmpCol To MaxEmp 'loop through employees
Warnflag = False
For Y = StartRow To MaxRow - 16 'loop through hours
SubTTl = Application.WorksheetFunction.Sum(Range(Cells(Y,
X), Cells(Y + 16, X)))
If (SubTTl >= WarnHrs) And Not Warnflag Then
If SubTTl >= MaxHrs Then
Range(Cells(Y, X), Cells(Y + 16,
X)).Interior.ColorIndex = 3
Cells(3, X) = SubTTl
Cells(2, X).Interior.ColorIndex = 3
Warnflag = True
Else
Range(Cells(Y, X), Cells(Y + 16,
X)).Interior.ColorIndex = 40
Cells(2, X).Interior.ColorIndex = 40
Cells(3, X) = SubTTl
End If
Exit For
End If
Next Y
Next X
Application.EnableEvents = True
End Sub

'--------------------------------------------------------

The Worksheet_Change event will cause the entire sheet to be "re-
evaluated".
If you want, you can change the sub to a function that receives the
Column number to evaluate. then use the worksheet_change event to pass
the column number (target.column) and only evaluate the employee being
modified.

you can use the Intersect Method to only re-calculate if the number in
the hours is changed (not elsewhere) like:


If (Not Intersect(Range(Target.Address), Range("B4:Z1000")) Is Nothing)
Then

The working  time directive states that a man can work no more than 48 hrs in any
rolling 17 week period.
So that equates to 816 hrs for 17 week after which i want the cell which
contains the mans name to turn red.

Week 1 total  hours are in cell E4
Week 2 total hours are in cell E5

and so on for the rest of the year.

So i need one subroutine that check the total hours E4 to E20 (17 weeks) and if
it is more than 816 then turn E2 cell colour Red.

I can then adapt the code to include other ranges ie E5 to E21,E6 to E22 ect.

I have done it woth conditional formatting and calculating the 17 week to a
single cell but it would be easier to adapt and edit if it was done with VBA.

I can post you the file if that will help.

I'm not an excel expert but perhpas you could take a different approach to
solving the problem.

If you organize the data with employee, week no, and hours worked as the
columns the conditional formating function should be straight forward using a
conditional sum and the results are returned correctly if you sort the data by
employee and then week no.

Then its just a matter of adding a flag column and creating another table the
reports it in the fashion you choose (employee names as column headers and week
numbers as rows), no programming is neccessary.

For instance if I add a flag to each row using the table structure suggested
above, the reporting format can be determined by using a lookup function or
database function for the last row of the employee name and reading its flag
value (green, yellow, red).

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

I have actually got it finished by just using excel to sum each of the 17 week
periods.

Week 1 to 17 (E4:E20) sums to BR4
Week 2 to 18 (E5:E21) sums to BR5
Week 3 to 19 (E6:E22) sums to BR6

And so on.

Then Conditional format checks the range in BR4:BR53 and if any cell exceeds my
specified range then the cell colour is changed.