Logo 
Search:

MS Office Answers

Ask Question   UnAnswered
Home » Forum » MS Office       RSS Feeds
  Question Asked By: Dale Matthews   on Mar 14 In MS Office Category.

  
Question Answered By: Virgil Foster   on Mar 14

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

Share: 

 

This Question has 9 more answer(s). View Complete Question Thread

 
Didn't find what you were looking for? Find more on Working Time Directive Spreadsheet Or get search suggestion and latest updates.


Tagged: