Hello,
I have a big problem of function. The first part of this function goes perfectly (Thanks Harry) but not the second part (the mine!!). That makes one week that I try to solve my problem but I do not arrive there all alone.
I try to subtract on the whole saturdays after midday, Sundays the Bank holidays between Sunday and Friday as well as saturdays but I do not arrive there.
Here the whole of my functions as well as the functions for the blank holidaysdays. How then I to make for me leave there?.
This is the code:
Function TimeWorkedSeconds1(StartDate As Date, EndDate As Date) As Double
Dim DayStart As Date
Dim LunchStart As Date
Dim LunchEnd As Date
Dim DayEnd As Date
Dim WholeDay As Integer
Dim StartTime As Date
Dim EndTime As Date
Dim WorkedTime As Date
Dim DaySecs As Double
Dim TimeSecs As Integer
Dim DD As Long
Dim SD As Long
Dim HowManySunday As Double
Dim HowManySaturday As Double
Dim HowManyDayOff As Double
Dim HowManyDayOffSaturday As Double
Dim Result As Double
'DECLARE TIMES
DayStart = "09:00:00"
LunchStart = "12:00:00"
LunchEnd = "13:30:00"
DayEnd = "17:30:00"
DD = vbSunday
SD = vbSaturday
'WORK OUT WHOLE DAYS
WholeDay = Int(EndDate - StartDate)
'WORK OUT REMAINDER OF TIME
'START BY LIMITING TO BEGINNING AND END OF WORKING DAY AND ALTER WholeDay ACCORDINGLY
If Format(StartDate, "hh:mm:ss") < DayStart Then
StartTime = Format(DayStart, "hh:mm:ss")
ElseIf Format(StartDate, "hh:mm:ss") > DayEnd Then
StartTime = Format(DayStart, "hh:mm:ss")
WholeDay = WholeDay - 1
Else
StartTime = Format(StartDate, "hh:mm:ss")
End If
If Format(EndDate, "hh:mm:ss") < DayStart Then
EndTime = Format(DayEnd, "hh:mm:ss")
WholeDay = WholeDay - 1
ElseIf Format(EndDate, "hh:mm:ss") > DayEnd Then
EndTime = Format(DayEnd, "hh:mm:ss")
Else
EndTime = Format(EndDate, "hh:mm:ss")
End If
'FOR START TIME BEFORE END TIME
If StartTime < EndTime Then
If StartTime < LunchStart Then
If EndTime < LunchStart Then
WorkedTime = EndTime - StartTime
ElseIf EndTime < LunchEnd Then
WorkedTime = LunchStart - StartTime
Else
WorkedTime = EndTime - StartTime + LunchStart - LunchEnd
End If
ElseIf StartTime < LunchEnd Then
If EndTime < LunchEnd Then
WorkedTime = 0
Else
WorkedTime = EndTime - LunchEnd
End If
Else
WorkedTime = EndTime - StartTime
End If
ElseIf StartTime = EndTime Then
WorkedTime = 0
Else
If StartTime < LunchStart Then
WorkedTime = DayEnd - StartTime + LunchStart - LunchEnd + EndTime - DayStart
ElseIf StartTime < LunchEnd Then
If EndTime < LunchStart Then
WorkedTime = DayEnd - LunchEnd + EndTime - DayStart
Else
WorkedTime = DayEnd - LunchEnd + LunchStart - DayStart
End If
Else
If EndTime < LunchStart Then
WorkedTime = DayEnd - StartTime + EndTime - DayStart
ElseIf EndTime < LunchEnd Then
WorkedTime = DayEnd - StartTime + LunchStart - DayStart
Else
WorkedTime = DayEnd - StartTime + EndTime - LunchEnd + LunchStart - DayStart
End If
End If
End If
'TIME WORKED!!
DaySecs = (DayEnd - LunchEnd + LunchStart - DayStart) * 86400 * WholeDay
TimeSecs = WorkedTime * 86400
Result = DaySecs + TimeSecs
HowManySunday = (DateDiff("ww", StartDate, EndDate, DD) - Int(DD = Weekday(StartDate))) * 25200
Result = Result - HowManySunday
'COUNT & SUBTRACT BANK HOLIDAYS FROM MONDAYS TO FRIDAY
HowManyDayOff = CptJourFerieLunVen(StartDate, EndDate) * 25200
Result = Result - HowManyDayOff
'COUNT & SUBTRACT BANK HOLIDAYS JUST FOR SATURDAYS
HowManyDayOffSaturday = CptJourFerieSamedi(StartDate, EndDate) * 10800
Result = Result - HowManyDayOffSaturday
TimeWorkedSeconds1 = Result
'COUNT & SUBTRACT THE SATURDAYS
HowManySaturday = (DateDiff("ww", StartDate, EndDate, SD) - Int(SD = Weekday(StartDate)))
If HowManySaturday = 1 Then
If Format(StartDate, "dddd") = "samedi" And Format(EndDate, "dddd") = "samedi" Then
'He doesn't run here, he doesn't run the test
If Format(EndTime, "hh:mm:ss") < LunchStart Then
Result = Result
ElseIf Format(EndTime, "hh:mm:ss") > LunchEnd Then
Result = Result - DateDiff("s", LunchEnd, EndTime)
End If
ElseIf Format(StartDate, "dddd") <> "samedi" And Format(EndDate, "dddd") = "samedi" Then
If Format(EndTime, "hh:mm:ss") < LunchStart Then
Result = Result - DateDiff("s", EndTime, LunchStart)
ElseIf Format(EndTime, "hh:mm:ss") > LunchEnd Then
Result = Result - DateDiff("s", LunchEnd, EndTime)
End If
ElseIf Format(StartDate, "dddd") = "samedi" And Format(EndDate, "dddd") <> "samedi" Then
If Format(StartTime, "hh:mm:ss") < LunchStart Then
Result = Result - DateDiff("s", LunchEnd, DayEnd)
ElseIf Format(StartTime, "hh:mm:ss") > LunchEnd Then
Result = Result - DateDiff("s", StartTime, DayEnd)
End If
End If
ElseIf HowManySaturday = 2 Then
If Format(StartDate, "dddd") = "samedi" And Format(EndDate, "dddd") = "samedi" Then
If Format(StartTime, "hh:mm:ss") < LunchStart And Format(EndTime, "hh:mm:ss") < LunchStart Then
Result = Result - DateDiff("s", LunchEnd, DayEnd)
ElseIf Format(StartTime, "hh:mm:ss") < LunchStart And Format(EndTime, "hh:mm:ss") > LunchEnd Then
Result = Result - DateDiff("s", LunchEnd, DayEnd) - DateDiff("s", LunchEnd, EndTime)
ElseIf Format(StartTime, "hh:mm:ss") > LunchStart And Format(EndTime, "hh:mm:ss") < LunchEnd Then
Result = Result - DateDiff("s", StartTime, DayEnd)
ElseIf Format(StartTime, "hh:mm:ss") > LunchStart And Format(EndTime, "hh:mm:ss") > LunchEnd Then
Result = Result - DateDiff("s", StartTime, DayEnd) - DateDiff("s", LunchEnd, EndTime)
End If
ElseIf Format(StartDate, "dddd") <> "samedi" And Format(EndDate, "dddd") <> "samedi" Then
Result = Result - 28800
End If
ElseIf HowManySaturday >= 3 Then
If Format(StartDate, "dddd") = "samedi" And Format(EndDate, "dddd") = "samedi" Then
If Format(StartTime, "hh:mm:ss") < LunchStart And Format(EndTime, "hh:mm:ss") < LunchStart Then
Result = Result - DateDiff("s", LunchEnd, DayEnd) - (HowManySaturday - 2) * 28800
ElseIf Format(StartTime, "hh:mm:ss") < LunchStart And Format(EndTime, "hh:mm:ss") > LunchEnd Then
Result = Result - DateDiff("s", LunchEnd, DayEnd) - DateDiff("s", LunchEnd, EndTime) - (HowManySaturday - 2) * 28800
ElseIf Format(StartTime, "hh:mm:ss") > LunchStart And Format(EndTime, "hh:mm:ss") < LunchEnd Then
Result = Result - DateDiff("s", StartTime, DayEnd) - (HowManySaturday - 2) * 28800
ElseIf Format(StartTime, "hh:mm:ss") > LunchStart And Format(EndTime, "hh:mm:ss") > LunchEnd Then
Result = Result - DateDiff("s", StartTime, DayEnd) - DateDiff("s", LunchEnd, EndTime) - (HowManySaturday - 2) * 28800
End If
ElseIf Format(StartDate, "dddd") <> "samedi" And Format(EndDate, "dddd") <> "samedi" Then
Result = Result - 28800 - (HowManySaturday - 2) * 28800
End If
End If
If TimeWorkedSeconds1 < 0 Then
TimeWorkedSeconds1 = 0
End If
TimeWorkedSeconds1 = TimeWorkedSeconds1
End Function
'THIS FUNCTION COUNT THE NUMBER OF BANK HOLIDAYS BETWEEN TWO DATES EXCEPT FOR SATURDAY AND SUNDAY
Function CptJourFerieLunVen(DateDebut As Variant, DateFin As Variant) As Integer
Dim DateCnt As Variant
Dim EndDays As Integer
DateDebut = DateValue(DateDebut)
DateFin = DateValue(DateFin)
DateCnt = DateDebut
EndDays = 0
Do While DateCnt <= DateFin
If Format(DateCnt, "ddd") <> "Sun" And Format(DateCnt, "ddd") <> "Sat" Then
If Not IsNull(DLookup("DateJourFérié", "tblJoursFériés", "[DateJourFérié]= #" & Format(DateCnt, "mm/dd/yy") & "#")) Then
EndDays = EndDays + 1
End If
End If
DateCnt = DateAdd("d", 1, DateCnt)
Loop
CptJourFerieLunVen = EndDays
End Function
'THIS FUNCTION COUNT THE NUMBER OF
'BANK HOLIDAYS JUST FOR SATURDAY BETWEEN TWO DATES
' EXCEPT FOR SATURDAY AND SUNDAY
Function CptJourFerieSamedi(DateDebut As Variant, DateFin As Variant) As Integer
Dim DateCnt As Variant
Dim EndDays As Integer
Dim DD As Long
DateDebut = DateValue(DateDebut)
DateFin = DateValue(DateFin)
DateCnt = DateDebut
EndDays = 0
Do While DateCnt <= DateFin
If Not IsNull(DLookup("DateJourFérié", "tblJoursFériésSaturday", "[DateJourFérié]= #" & Format(DateCnt, "mm/dd/yy") & "#")) Then
EndDays = EndDays + 1
End If
DateCnt = DateAdd("d", 1, DateCnt)
Loop
CptJourFerieSamedi = EndDays
End Function
Your help will be appreciated. The date in my function is in french format but my database run when i change the format of my regional parameter in english for UK
Nilses
I have a big problem of function. The first part of this function goes perfectly (Thanks Harry) but not the second part (the mine!!). That makes one week that I try to solve my problem but I do not arrive there all alone.
I try to subtract on the whole saturdays after midday, Sundays the Bank holidays between Sunday and Friday as well as saturdays but I do not arrive there.
Here the whole of my functions as well as the functions for the blank holidaysdays. How then I to make for me leave there?.
This is the code:
Function TimeWorkedSeconds1(StartDate As Date, EndDate As Date) As Double
Dim DayStart As Date
Dim LunchStart As Date
Dim LunchEnd As Date
Dim DayEnd As Date
Dim WholeDay As Integer
Dim StartTime As Date
Dim EndTime As Date
Dim WorkedTime As Date
Dim DaySecs As Double
Dim TimeSecs As Integer
Dim DD As Long
Dim SD As Long
Dim HowManySunday As Double
Dim HowManySaturday As Double
Dim HowManyDayOff As Double
Dim HowManyDayOffSaturday As Double
Dim Result As Double
'DECLARE TIMES
DayStart = "09:00:00"
LunchStart = "12:00:00"
LunchEnd = "13:30:00"
DayEnd = "17:30:00"
DD = vbSunday
SD = vbSaturday
'WORK OUT WHOLE DAYS
WholeDay = Int(EndDate - StartDate)
'WORK OUT REMAINDER OF TIME
'START BY LIMITING TO BEGINNING AND END OF WORKING DAY AND ALTER WholeDay ACCORDINGLY
If Format(StartDate, "hh:mm:ss") < DayStart Then
StartTime = Format(DayStart, "hh:mm:ss")
ElseIf Format(StartDate, "hh:mm:ss") > DayEnd Then
StartTime = Format(DayStart, "hh:mm:ss")
WholeDay = WholeDay - 1
Else
StartTime = Format(StartDate, "hh:mm:ss")
End If
If Format(EndDate, "hh:mm:ss") < DayStart Then
EndTime = Format(DayEnd, "hh:mm:ss")
WholeDay = WholeDay - 1
ElseIf Format(EndDate, "hh:mm:ss") > DayEnd Then
EndTime = Format(DayEnd, "hh:mm:ss")
Else
EndTime = Format(EndDate, "hh:mm:ss")
End If
'FOR START TIME BEFORE END TIME
If StartTime < EndTime Then
If StartTime < LunchStart Then
If EndTime < LunchStart Then
WorkedTime = EndTime - StartTime
ElseIf EndTime < LunchEnd Then
WorkedTime = LunchStart - StartTime
Else
WorkedTime = EndTime - StartTime + LunchStart - LunchEnd
End If
ElseIf StartTime < LunchEnd Then
If EndTime < LunchEnd Then
WorkedTime = 0
Else
WorkedTime = EndTime - LunchEnd
End If
Else
WorkedTime = EndTime - StartTime
End If
ElseIf StartTime = EndTime Then
WorkedTime = 0
Else
If StartTime < LunchStart Then
WorkedTime = DayEnd - StartTime + LunchStart - LunchEnd + EndTime - DayStart
ElseIf StartTime < LunchEnd Then
If EndTime < LunchStart Then
WorkedTime = DayEnd - LunchEnd + EndTime - DayStart
Else
WorkedTime = DayEnd - LunchEnd + LunchStart - DayStart
End If
Else
If EndTime < LunchStart Then
WorkedTime = DayEnd - StartTime + EndTime - DayStart
ElseIf EndTime < LunchEnd Then
WorkedTime = DayEnd - StartTime + LunchStart - DayStart
Else
WorkedTime = DayEnd - StartTime + EndTime - LunchEnd + LunchStart - DayStart
End If
End If
End If
'TIME WORKED!!
DaySecs = (DayEnd - LunchEnd + LunchStart - DayStart) * 86400 * WholeDay
TimeSecs = WorkedTime * 86400
Result = DaySecs + TimeSecs
HowManySunday = (DateDiff("ww", StartDate, EndDate, DD) - Int(DD = Weekday(StartDate))) * 25200
Result = Result - HowManySunday
'COUNT & SUBTRACT BANK HOLIDAYS FROM MONDAYS TO FRIDAY
HowManyDayOff = CptJourFerieLunVen(StartDate, EndDate) * 25200
Result = Result - HowManyDayOff
'COUNT & SUBTRACT BANK HOLIDAYS JUST FOR SATURDAYS
HowManyDayOffSaturday = CptJourFerieSamedi(StartDate, EndDate) * 10800
Result = Result - HowManyDayOffSaturday
TimeWorkedSeconds1 = Result
'COUNT & SUBTRACT THE SATURDAYS
HowManySaturday = (DateDiff("ww", StartDate, EndDate, SD) - Int(SD = Weekday(StartDate)))
If HowManySaturday = 1 Then
If Format(StartDate, "dddd") = "samedi" And Format(EndDate, "dddd") = "samedi" Then
'He doesn't run here, he doesn't run the test
If Format(EndTime, "hh:mm:ss") < LunchStart Then
Result = Result
ElseIf Format(EndTime, "hh:mm:ss") > LunchEnd Then
Result = Result - DateDiff("s", LunchEnd, EndTime)
End If
ElseIf Format(StartDate, "dddd") <> "samedi" And Format(EndDate, "dddd") = "samedi" Then
If Format(EndTime, "hh:mm:ss") < LunchStart Then
Result = Result - DateDiff("s", EndTime, LunchStart)
ElseIf Format(EndTime, "hh:mm:ss") > LunchEnd Then
Result = Result - DateDiff("s", LunchEnd, EndTime)
End If
ElseIf Format(StartDate, "dddd") = "samedi" And Format(EndDate, "dddd") <> "samedi" Then
If Format(StartTime, "hh:mm:ss") < LunchStart Then
Result = Result - DateDiff("s", LunchEnd, DayEnd)
ElseIf Format(StartTime, "hh:mm:ss") > LunchEnd Then
Result = Result - DateDiff("s", StartTime, DayEnd)
End If
End If
ElseIf HowManySaturday = 2 Then
If Format(StartDate, "dddd") = "samedi" And Format(EndDate, "dddd") = "samedi" Then
If Format(StartTime, "hh:mm:ss") < LunchStart And Format(EndTime, "hh:mm:ss") < LunchStart Then
Result = Result - DateDiff("s", LunchEnd, DayEnd)
ElseIf Format(StartTime, "hh:mm:ss") < LunchStart And Format(EndTime, "hh:mm:ss") > LunchEnd Then
Result = Result - DateDiff("s", LunchEnd, DayEnd) - DateDiff("s", LunchEnd, EndTime)
ElseIf Format(StartTime, "hh:mm:ss") > LunchStart And Format(EndTime, "hh:mm:ss") < LunchEnd Then
Result = Result - DateDiff("s", StartTime, DayEnd)
ElseIf Format(StartTime, "hh:mm:ss") > LunchStart And Format(EndTime, "hh:mm:ss") > LunchEnd Then
Result = Result - DateDiff("s", StartTime, DayEnd) - DateDiff("s", LunchEnd, EndTime)
End If
ElseIf Format(StartDate, "dddd") <> "samedi" And Format(EndDate, "dddd") <> "samedi" Then
Result = Result - 28800
End If
ElseIf HowManySaturday >= 3 Then
If Format(StartDate, "dddd") = "samedi" And Format(EndDate, "dddd") = "samedi" Then
If Format(StartTime, "hh:mm:ss") < LunchStart And Format(EndTime, "hh:mm:ss") < LunchStart Then
Result = Result - DateDiff("s", LunchEnd, DayEnd) - (HowManySaturday - 2) * 28800
ElseIf Format(StartTime, "hh:mm:ss") < LunchStart And Format(EndTime, "hh:mm:ss") > LunchEnd Then
Result = Result - DateDiff("s", LunchEnd, DayEnd) - DateDiff("s", LunchEnd, EndTime) - (HowManySaturday - 2) * 28800
ElseIf Format(StartTime, "hh:mm:ss") > LunchStart And Format(EndTime, "hh:mm:ss") < LunchEnd Then
Result = Result - DateDiff("s", StartTime, DayEnd) - (HowManySaturday - 2) * 28800
ElseIf Format(StartTime, "hh:mm:ss") > LunchStart And Format(EndTime, "hh:mm:ss") > LunchEnd Then
Result = Result - DateDiff("s", StartTime, DayEnd) - DateDiff("s", LunchEnd, EndTime) - (HowManySaturday - 2) * 28800
End If
ElseIf Format(StartDate, "dddd") <> "samedi" And Format(EndDate, "dddd") <> "samedi" Then
Result = Result - 28800 - (HowManySaturday - 2) * 28800
End If
End If
If TimeWorkedSeconds1 < 0 Then
TimeWorkedSeconds1 = 0
End If
TimeWorkedSeconds1 = TimeWorkedSeconds1
End Function
'THIS FUNCTION COUNT THE NUMBER OF BANK HOLIDAYS BETWEEN TWO DATES EXCEPT FOR SATURDAY AND SUNDAY
Function CptJourFerieLunVen(DateDebut As Variant, DateFin As Variant) As Integer
Dim DateCnt As Variant
Dim EndDays As Integer
DateDebut = DateValue(DateDebut)
DateFin = DateValue(DateFin)
DateCnt = DateDebut
EndDays = 0
Do While DateCnt <= DateFin
If Format(DateCnt, "ddd") <> "Sun" And Format(DateCnt, "ddd") <> "Sat" Then
If Not IsNull(DLookup("DateJourFérié", "tblJoursFériés", "[DateJourFérié]= #" & Format(DateCnt, "mm/dd/yy") & "#")) Then
EndDays = EndDays + 1
End If
End If
DateCnt = DateAdd("d", 1, DateCnt)
Loop
CptJourFerieLunVen = EndDays
End Function
'THIS FUNCTION COUNT THE NUMBER OF
'BANK HOLIDAYS JUST FOR SATURDAY BETWEEN TWO DATES
' EXCEPT FOR SATURDAY AND SUNDAY
Function CptJourFerieSamedi(DateDebut As Variant, DateFin As Variant) As Integer
Dim DateCnt As Variant
Dim EndDays As Integer
Dim DD As Long
DateDebut = DateValue(DateDebut)
DateFin = DateValue(DateFin)
DateCnt = DateDebut
EndDays = 0
Do While DateCnt <= DateFin
If Not IsNull(DLookup("DateJourFérié", "tblJoursFériésSaturday", "[DateJourFérié]= #" & Format(DateCnt, "mm/dd/yy") & "#")) Then
EndDays = EndDays + 1
End If
DateCnt = DateAdd("d", 1, DateCnt)
Loop
CptJourFerieSamedi = EndDays
End Function
Your help will be appreciated. The date in my function is in french format but my database run when i change the format of my regional parameter in english for UK
Nilses