S
Sambusa
Sebastienm... myrna larson wrote this :
( Here's the "final" code. It requires that you have installed the
Analysis Tool
Pack. If you haven't done that, the code won't compile.
To use this, go to the VB Editor (ALT+F11) and select your workbook
over in
the upper left hand project pane.
Then go to the Tools menu, select References, and put a check mark in
front of
ATPVBAEN.XLA, or whatever it's named in your version (the 'EN' may be
different).
Then insert a module and paste all of the code below (beginning with
the line
Option Explicit) into the large code window you see on the right side
of the
screen.
Then write a formula like HoursWorked(A1,A2,K1:K10) where the starting
date
and time are in A1, the ending date and time are in A2, and K1:K10
contains a
list of legal holidays (with 2 added to each calendar date to handle
the fact
that your weekend days are Thu and Fri rather than Sat and Sun). Note
that the
holidays must be in a range. I didn't spend time on the extra coding
needed to
handle a literal array of holidays.
Option Explicit
Private Const WorkdayStart As Double = 5 / 24
Private Const WorkdayEnd As Double = 18 / 24
Private Const WorkdayLen As Double = WorkdayEnd - WorkdayStart
Function HoursWorked(StartTime As Date, EndTime As Date, _
Optional Holidays As Range = Nothing) As Double
Dim D1 As Long
Dim D2 As Long
Dim H As Double
Dim N As Long
Dim T1 As Double
Dim T2 As Double
D1 = CLng(Int(StartTime))
T1 = ValidTime(StartTime)
D2 = CLng(Int(EndTime))
T2 = ValidTime(EndTime)
H = 0
If D2 = D1 Then 'start and finish on same day
N = GetWorkdays(D1, D1, Holidays)
If (N > 0) And (T2 > T1) Then H = T2 - T1
ElseIf D1 < D2 Then 'finish on a later day
'hours for first (partial?) day:
'start at T1, end at end of workday
N = GetWorkdays(D1, D1, Holidays)
If N > 0 Then H = WorkdayEnd - T1
'hours for full workdays, D1+1 through D2-1, inclusive
N = GetWorkdays(D1 + 1, D2 - 1, Holidays)
If N > 0 Then H = H + N * WorkdayLen
'hours for final (partial?) day:
'start at beginning of workday, end at T2
N = GetWorkdays(D2, D2, Holidays)
If N > 0 Then H = H + T2 - WorkdayStart
End If
HoursWorked = H
End Function
Private Function GetWorkdays(Date1 As Long, Date2 As Long, _
Optional Holidays As Range = Nothing) As Long
'NB: Thursday and Friday are weekend days, so add 2 to the dates
'when calling NETWORKDAYS so the ATP function will think Thu and Fri
'are Sat and Sun, and thus not working days
If Holidays Is Nothing Then
GetWorkdays = NETWORKDAYS(Date1 + 2, Date2 + 2)
Else
GetWorkdays = NETWORKDAYS(Date1 + 2, Date2 + 2, Holidays)
End If
End Function
Private Function ValidTime(D As Date) As Double
'given a date and time, isolate the time portion
'and constrain to limits of the work day
Dim tt As Double
tt = D - Int(D)
If tt < WorkdayStart Then tt = WorkdayStart
If tt > WorkdayEnd Then tt = WorkdayEnd
ValidTime = tt
End Function
)
Can u help where i have to paste & run it to get the diff between date
& time pls
If u can check the attchment pls ...
Waiting
Thanks for ur help
SAMI
( Here's the "final" code. It requires that you have installed the
Analysis Tool
Pack. If you haven't done that, the code won't compile.
To use this, go to the VB Editor (ALT+F11) and select your workbook
over in
the upper left hand project pane.
Then go to the Tools menu, select References, and put a check mark in
front of
ATPVBAEN.XLA, or whatever it's named in your version (the 'EN' may be
different).
Then insert a module and paste all of the code below (beginning with
the line
Option Explicit) into the large code window you see on the right side
of the
screen.
Then write a formula like HoursWorked(A1,A2,K1:K10) where the starting
date
and time are in A1, the ending date and time are in A2, and K1:K10
contains a
list of legal holidays (with 2 added to each calendar date to handle
the fact
that your weekend days are Thu and Fri rather than Sat and Sun). Note
that the
holidays must be in a range. I didn't spend time on the extra coding
needed to
handle a literal array of holidays.
Option Explicit
Private Const WorkdayStart As Double = 5 / 24
Private Const WorkdayEnd As Double = 18 / 24
Private Const WorkdayLen As Double = WorkdayEnd - WorkdayStart
Function HoursWorked(StartTime As Date, EndTime As Date, _
Optional Holidays As Range = Nothing) As Double
Dim D1 As Long
Dim D2 As Long
Dim H As Double
Dim N As Long
Dim T1 As Double
Dim T2 As Double
D1 = CLng(Int(StartTime))
T1 = ValidTime(StartTime)
D2 = CLng(Int(EndTime))
T2 = ValidTime(EndTime)
H = 0
If D2 = D1 Then 'start and finish on same day
N = GetWorkdays(D1, D1, Holidays)
If (N > 0) And (T2 > T1) Then H = T2 - T1
ElseIf D1 < D2 Then 'finish on a later day
'hours for first (partial?) day:
'start at T1, end at end of workday
N = GetWorkdays(D1, D1, Holidays)
If N > 0 Then H = WorkdayEnd - T1
'hours for full workdays, D1+1 through D2-1, inclusive
N = GetWorkdays(D1 + 1, D2 - 1, Holidays)
If N > 0 Then H = H + N * WorkdayLen
'hours for final (partial?) day:
'start at beginning of workday, end at T2
N = GetWorkdays(D2, D2, Holidays)
If N > 0 Then H = H + T2 - WorkdayStart
End If
HoursWorked = H
End Function
Private Function GetWorkdays(Date1 As Long, Date2 As Long, _
Optional Holidays As Range = Nothing) As Long
'NB: Thursday and Friday are weekend days, so add 2 to the dates
'when calling NETWORKDAYS so the ATP function will think Thu and Fri
'are Sat and Sun, and thus not working days
If Holidays Is Nothing Then
GetWorkdays = NETWORKDAYS(Date1 + 2, Date2 + 2)
Else
GetWorkdays = NETWORKDAYS(Date1 + 2, Date2 + 2, Holidays)
End If
End Function
Private Function ValidTime(D As Date) As Double
'given a date and time, isolate the time portion
'and constrain to limits of the work day
Dim tt As Double
tt = D - Int(D)
If tt < WorkdayStart Then tt = WorkdayStart
If tt > WorkdayEnd Then tt = WorkdayEnd
ValidTime = tt
End Function
)
Can u help where i have to paste & run it to get the diff between date
& time pls
If u can check the attchment pls ...
Waiting
Thanks for ur help
SAMI