' ========================================================================================================================
' ____,__, __, ____,_, _, ____ ____,__, ,____,____,
' (-/_|(-| (-| (-|_,(-|\ | (-|__|-/_|( |_/(-|_,(-|__)
' _/ |,_|__,_|__,_|__,_| \|, _|__)/ |,_| \,_|__,_| \,
'
' Copyright � 2009 Allen Baker
'
' ------------------------------------------------------------------------------------------------------------------------
' File: M019_DateTime
' Originator: Allen Baker (2009.10.31 00:37)
' ------------------------------------------------------------------------------------------------------------------------
' $RCSfile$
' $Revision$
' $Date$
' ========================================================================================================================
'
Option Explicit
' ========================================================================================================================
' Description
' This module provides procedures that supplement the Date type.
' ========================================================================================================================
' =====================================================================================================================
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@[ Constants ]@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' =====================================================================================================================
' =====================================================================================================================
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@[ Module Variables ]@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' =====================================================================================================================
' =====================================================================================================================
' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<[ Timezone Utilities ]>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
' =====================================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This is a function declaration for a native Windows API that is used to figure out what time zone the
' computer that is running this Excel file is in. It retrieves the current time zone settings. These
' settings control the translations between Coordinated Universal Time (UTC) and local time.
'
' To support boundaries for daylight saving time that change from year to year, use the
' GetDynamicTimeZoneInformation or GetTimeZoneInformationForYear function
'
' return
' If the function succeeds, it returns one of the following values.
'
' Return code value Description
' -------------------- ------ -----------------------------------------------------------
' TIME_ZONE_ID_UNKNOWN 0 Daylight saving time is not used in the current current time zone, because
' there are no transition dates or automatic adjustment for daylight saving
' time is disabled.
'
' TIME_ZONE_ID_STANDARD 1 The system is operating in the range covered by the StandardDate member
' of the TIME_ZONE_INFORMATION structure.
'
' TIME_ZONE_ID_DAYL 2 The system is operating in the range covered by the DaylightDate member
' of the TIME_ZONE_INFORMATION structure.
'
' If the function fails for other reasons, such as an out of memory error, it returns
' TIME_ZONE_ID_INVALID. To get extended error information, call GetLastError.
'
' param
' lpTimeZoneInformation [out] is a pointer to a TIME_ZONE_INFORMATION structure to receive the current
' settings.
' -----------------------------------------------------------------------------------------------------------
Private Declare Function GetTimeZoneInformationAny Lib "kernel32" Alias "GetTimeZoneInformation" (buffer As Any) As Long
' =====================================================================================================================
' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<[ Miscellaneous ]>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
' =====================================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' Given the hour in the GMT timezone and an offset from GMT of a target timezone, this function returns the
' hour in the target timezone.
'
' return
' the hour in the target timezone
'
' param
' pHourInGMT is the current hour in the GMT time zone
' param
' pOffsetOfTargetTimeZone is the number of hours that the target time zone is offset from GMT
' -----------------------------------------------------------------------------------------------------------
Public Function offsetHour(pHourInGMT As Long, pOffsetOfTargetTimeZone As Double) As Long
'
' ==============================================================================================
' variables used
' ----------------------------------------------------------------------------------------------
Dim offsetInMinutes As Double
Dim offsetFractionalMinutes As Double
Dim offsetIntegralHours As Long
'
' ==============================================================================================
' convert the offset from hours to minutes
' ----------------------------------------------------------------------------------------------
offsetInMinutes = pOffsetOfTargetTimeZone * 60#
'
' ==============================================================================================
' strip off the fractional minutes (the minutes that represent a partial hour)
' ----------------------------------------------------------------------------------------------
offsetFractionalMinutes = fmod(offsetInMinutes, 60#)
offsetIntegralHours = CLng((offsetInMinutes - offsetFractionalMinutes) / 60#)
'
' ==============================================================================================
' now convert and return the hour part of the offset to an hour in the target timezone
' ----------------------------------------------------------------------------------------------
offsetHour = (pHourInGMT + 24 + offsetIntegralHours) Mod 24
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns the fractional part of a number given in hours (like 2.33 hours) into minutes. For
' example, if pHours=1.5 then this function converts the .5 to 30 minutes.
'
' return
' the fractional part of a number given in hours
'
' param
' pHours is the number given in hours for which the fractional part is returned as minutes.
' -----------------------------------------------------------------------------------------------------------
Public Function fractionalMinutes(pHours As Double) As Long
fractionalMinutes = CLng(fmod((pHours * 60#), 60#))
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function convers a double into minutes:seconds. It assumes the double represents a number and a
' fractional part of minutes. For example, if pMins=2.25, then this function returns "2:15"
'
' return
' the minutes and seconds as a string in this format "mm:ss"
'
' param
' pMins is the number of minutes as a double.
' -----------------------------------------------------------------------------------------------------------
Public Function doubleToMinutesAndSeconds(pMins As Double) As String
Dim minutes As Long
Dim seconds As Long
minutes = Int(pMins)
seconds = (pMins - minutes) * 60
doubleToMinutesAndSeconds = minutes & ":" & seconds
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns true if the given year is a leap year
'
' return
' true if pYear is a leap year, false if not.
'
' param
' pYear is the year to test and determine if it is a leap year.
' -----------------------------------------------------------------------------------------------------------
Public Function isLeapYear(pYear As Long) As Boolean
isLeapYear = False
If ((pYear Mod 400) = 0) Then
isLeapYear = True
ElseIf ((pYear Mod 100) = 0) Then
isLeapYear = False
ElseIf ((pYear Mod 4) = 0) Then
isLeapYear = True
End If
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns the quarter and fiscal year for the data parameter in the format illustrated in this
' example:
' Q408
'
' return
' a string representation of the fiscal quarter and year.
'
' param
' pDate is the date for which the fiscal quarter and year is computed
' -----------------------------------------------------------------------------------------------------------
Public Function q(pDate As Date) As String
Dim m As Long
m = Month(pDate)
If (m = 11) Or (m = 12) Then
q = "Q1" & Right(Year(pDate + cDaysPerYear), 2)
ElseIf (m = 1) Then
q = "Q1" & Right(Year(pDate), 2)
ElseIf (m = 2) Or (m = 3) Or (m = 4) Then
q = "Q2" & Right(Year(pDate), 2)
ElseIf (m = 5) Or (m = 6) Or (m = 7) Then
q = "Q3" & Right(Year(pDate), 2)
ElseIf (m = 8) Or (m = 9) Or (m = 10) Then
q = "Q4" & Right(Year(pDate), 2)
Else
q = "bad"
End If
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns the age of something based on the given date and birthdate
'
' return
' an age in years
'
' param
' pDate is the date for which the age is computed
' param
' pBirthDate is the birth date for which the age is computed
' -----------------------------------------------------------------------------------------------------------
Public Function age(pDate As Date, pBirthDate As Date) As Double
age = CDbl(pDate - pBirthDate) / cDaysPerYear
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function determines if a given time is within the range of two other times - inclusive. It ignores
' the date portion of the parameters and does its comparison using only the time components of the
' parameters.
'
' return
' TRUE if pRangeStart <= pTime <= pRangeEnd, otherwise FALSE
'
' param
' pTime is the date/time whose time component is tested
' param
' pRangeStart is the date/time whose time component is the low end of the range
' param
' pRangeEnd is the date/time whose time component is the high end of the range
' -----------------------------------------------------------------------------------------------------------
Public Function timeIsInRange(pTime As Date, pRangeStart As Date, pRangeEnd As Date) As Boolean
'
' ==============================================================================================
' variables used
' ----------------------------------------------------------------------------------------------
Dim timeTimeCmpnt As Double
Dim minTimeCmpnt As Double
Dim maxTimeCmpnt As Double
'
' ==============================================================================================
' strip away the date portion of the datetime variables leaving only the time portions
' ----------------------------------------------------------------------------------------------
timeTimeCmpnt = pTime - Int(pTime)
minTimeCmpnt = pRangeStart - Int(pRangeStart)
maxTimeCmpnt = pRangeEnd - Int(pRangeEnd)
'
' ==============================================================================================
' find out if the time is in range
' ----------------------------------------------------------------------------------------------
timeIsInRange = isInRange(timeTimeCmpnt, minTimeCmpnt, maxTimeCmpnt)
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function determines whether or not a date is in a specified date range
'
' return
' this function returns true if pDate is in the date range [pRangeStart, pRangeEnd], inclusive,
' otherwise, it returns false.
'
' param
' pDate is the date to test for inclusion in the date range
' param
' pRangeStart is the date to that establishes the beginning of the date range
' param
' pRangeEnd is the date to that establishes the end of the date range
' -----------------------------------------------------------------------------------------------------------
Public Function dateIsInRange(pDate As Date, pRangeStart As Date, pRangeEnd As Date) As Boolean
'
' ==============================================================================================
' variables used
' ----------------------------------------------------------------------------------------------
Dim theDate As Date
Dim theStart As Date
Dim theEnd As Date
'
' ==============================================================================================
' just want the date part, not the date and time
' ----------------------------------------------------------------------------------------------
theDate = DateValue(pDate)
theStart = DateValue(pRangeStart)
theEnd = DateValue(pRangeEnd)
'
' ==============================================================================================
' find out if the date is in range
' ----------------------------------------------------------------------------------------------
dateIsInRange = (theStart <= theDate) And (theDate <= theEnd)
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns true if the given date is on a weekend
'
' return
' true if pDate is a weekend day, false if not.
'
' param
' pDate is the date to test and determine if it is a weekend day.
' -----------------------------------------------------------------------------------------------------------
Public Function isWeekendDay(pDate As Date) As Boolean
Dim dayOfWeek As Integer
dayOfWeek = Weekday(pDate)
isWeekendDay = ((dayOfWeek = vbSaturday) Or (dayOfWeek = vbSunday))
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns true if the given date is not on a weekend
'
' return
' true if pDate is not a weekend day, false if it is.
'
' param
' pDate is the date to test and determine if it is not a weekend day.
' -----------------------------------------------------------------------------------------------------------
Public Function isWeekDay(pDate As Date) As Boolean
isWeekDay = Not isWeekendDay(pDate)
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
'
' *** DEPRECATED ***
' This subroutine is for legacy compatibility only. It should not be used in new code. dateTimeAdd()
' should be used instead.
'
' This function increments a date/time by a specified amount of days,or hours, or minutes.
'
' return
' this function returns the incremented date/time value
'
' param
' pTime is the date/time to be incremented
' param
' pDuration is the number of units to increment pTime
' param
' pUnits identifies the units that pDuration is measured in. The units are 'd' for days, 'h' for hours,
' and 'm' (or anything else) for minutes
' -----------------------------------------------------------------------------------------------------------
Public Function timePlusDuration(pTime As Double, pDuration As Double, pUnits As String) As Double
'
' ==============================================================================================
' "D" means days, "H" means hours, anything else means the default - minutes
' ----------------------------------------------------------------------------------------------
Dim units As String
units = UCase(pUnits)
If (InStr(units, "D")) Then
timePlusDuration = dateTimeAdd(pTime, pDuration, "d")
ElseIf (InStr(units, "H")) Then
timePlusDuration = dateTimeAdd(pTime, pDuration, "h")
Else
timePlusDuration = dateTimeAdd(pTime, pDuration, "m")
End If
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function averages the values in a value range (pAvgRange) whose corresponding date in a date range
' (pTestRange) has the same year as pCriteriaYear
' Example: = avgRangeByYear(pTestRange,pAvgRange,2006)
'
' return
' the average
'
' param
' pTestRange is a range of dates
' param
' pCriteriaYear is a year
' param
' pAvgRange is a range of values
' -----------------------------------------------------------------------------------------------------------
Public Function avgRangeByYear(pTestRange As Range, pCriteriaYear As Date, pAvgRange As Range) As Double
Dim dt As Date
Dim vl As Double
Dim ttl As Double
Dim cnt As Long
Dim row As Long
ttl = 0#
cnt = 0
For row = 1 To 56
dt = pTestRange(row, 1)
vl = pAvgRange(row, 1)
If (Year(dt) = pCriteriaYear) Then
ttl = ttl + vl
cnt = cnt + 1
End If
Next row
avgRangeByYear = ttl / cnt
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function sums the values in a value range (pSumRange) whose corresponding date in a date range
' (pTestRange) has the same year as pCriteriaYear
' Example: = sumRangeByYear(dateRange,valueRange,2006)
'
' return
' the sum
'
' param
' pTestRange is a range of dates
' param
' pCriteriaYear is a year
' param
' pSumRange is a range of values
' -----------------------------------------------------------------------------------------------------------
Public Function sumRangeByYear(pTestRange As Range, pCriteriaYear As Date, pSumRange As Range) As Double
Dim dt As Date
Dim vl As Double
Dim ttl As Double
Dim row As Long
ttl = 0#
For row = 1 To 56
dt = pTestRange(row, 1)
vl = pSumRange(row, 1)
If (Year(dt) = pCriteriaYear) Then
ttl = ttl + vl
End If
Next row
sumRangeByYear = ttl
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns the date of the closest specified day of week (Sun, Mon, ...) on or after the given
' date.
'
' return
' this function returns the date of the specified day of week immediately after pDate. if pDate is
' itself the specified day of week, this function returns pDate
'
' param
' pDate is the date for which the most next specified day of week is found
' param
' pDayOfWeek is the string name of a day of week to search for such as "Sunday", "monday", etc. or an [at
' least 2 character] abbreviation such as "su", "mo", "tue", "tue", etc.
' -----------------------------------------------------------------------------------------------------------
Public Function nextDayOfWeek(pDate As Date, pDayOfWeek As String) As Date
Dim dayCode As Integer
Select Case Left(UCase(pDayOfWeek), 2)
Case "SU"
dayCode = vbSunday
Case "MO"
dayCode = vbMonday
Case "TU"
dayCode = vbTuesday
Case "WE"
dayCode = vbWednesday
Case "TH"
dayCode = vbThursday
Case "FR"
dayCode = vbFriday
Case "SA"
dayCode = vbSaturday
End Select
nextDayOfWeek = pDate
While (Weekday(nextDayOfWeek) <> dayCode)
nextDayOfWeek = DateAdd("d", 1, nextDayOfWeek)
Wend
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns the date of the closest specified day of week (Sun, Mon, ...) on or before the given
' date.
'
' return
' this function returns the date of the specified day of week immediately preceeding pDate. if pDate is
' itself the specified day of week, this function returns pDate
'
' param
' pDate is the date for which the most recent prior specified day of week is found
' param
' pDayOfWeek is the string name of a day of week to search for such as "Sunday", "monday", etc. or an [at
' least 2 character] abbreviation such as "su", "mo", "tue", "tue", etc.
' -----------------------------------------------------------------------------------------------------------
Public Function mostRecentDayOfWeek(pDate As Date, pDayOfWeek As String) As Date
Dim dayCode As Integer
Select Case Left(UCase(pDayOfWeek), 2)
Case "SU"
dayCode = vbSunday
Case "MO"
dayCode = vbMonday
Case "TU"
dayCode = vbTuesday
Case "WE"
dayCode = vbWednesday
Case "TH"
dayCode = vbThursday
Case "FR"
dayCode = vbFriday
Case "SA"
dayCode = vbSaturday
End Select
mostRecentDayOfWeek = pDate
While (Weekday(mostRecentDayOfWeek) <> dayCode)
mostRecentDayOfWeek = DateAdd("d", -1, mostRecentDayOfWeek)
Wend
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns the date of the closest sunday on or before the given date.
'
' return
' this function returns the date of the sunday immediately preceeding pDate. if pDate is itself a
' sunday, this function returns pDate
'
' param
' pDate is the date for which the most recent prior sunday is found
' -----------------------------------------------------------------------------------------------------------
Public Function mostRecentSunday(pDate As Date) As Date
mostRecentSunday = mostRecentDayOfWeek(pDate, "SUNDAY")
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This subroutine returns the quarter and fiscal year for a given date
'
' param
' pDate is the date for which the fiscal quarter and year is computed
' param (output)
' pQtr is where the fiscal quarter (1 - 4) will be stored when This subroutine returns
' param (output)
' pYr is where the fiscal year will be stored when This subroutine returns
' -----------------------------------------------------------------------------------------------------------
Public Sub fiscalPeriod(pDate As Date, pQtr As Long, pYr As Long)
Dim mo As Long
Dim yr As Long
mo = Month(pDate)
yr = Year(pDate)
Select Case mo
Case 11, 12
pQtr = 1
pYr = yr + 1
Case 1
pQtr = 1
pYr = yr
Case 2, 3, 4
pQtr = 2
pYr = yr
Case 5, 6, 7
pQtr = 3
pYr = yr
Case 8, 9, 10
pQtr = 4
pYr = yr
End Select
End Sub
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns the number of calendar days it takes to provide the given number of workdays
'
' return
' number of calendar days it takes to provide the given number of workdays
'
' param
' pStart is the calendar date to start searching for workdays from
' param
' pWorkdays is the number of workdays to find
' -----------------------------------------------------------------------------------------------------------
Public Function workdaysToCalendardays(pStart As Date, pWorkdays As Double) As Double
Dim caldays As Double
Dim workdaysRemaining As Double
Dim currday As Date
Dim startdayRemaining As Double
Dim allocated As Double
caldays = 0#
workdaysRemaining = pWorkdays
If workdaysRemaining > 0# Then
currday = CDate(Int(pStart))
startdayRemaining = 1 - (pStart - currday)
'
' ==============================================================================================
' use up what's left of the starting calendar day
' ----------------------------------------------------------------------------------------------
If isWeekDay(currday) Then
allocated = min(workdaysRemaining, startdayRemaining)
workdaysRemaining = workdaysRemaining - allocated
caldays = allocated
Else
caldays = startdayRemaining
End If
currday = currday + 1#
'
' ==============================================================================================
' now accumulate calendar days and quit when enough have been accumulated to cover the
' remaining workdays
' ----------------------------------------------------------------------------------------------
While workdaysRemaining > 0#
If isWeekDay(currday) Then
allocated = min(workdaysRemaining, 1#)
workdaysRemaining = workdaysRemaining - allocated
caldays = caldays + allocated
Else
caldays = caldays + 1#
End If
currday = currday + 1#
Wend
End If
workdaysToCalendardays = caldays
End Function
' =====================================================================================================================
' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<[ Selection-Specific DateTime Utilities ]>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
' =====================================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns true if the given date is a workday in the selected location, otherwise, it returns
' false
'
' return
' true if the given date is a workday in the selected location, otherwise, it returns false
'
' param
' pLocation is a String name for the location for which the holiday calendar is applied.
' param
' pDate is the day to test to see if it is a workday in the selected location
' -----------------------------------------------------------------------------------------------------------
Public Function isLocationWorkday(pLocation As String, pDate As Date) As Boolean
Select Case pLocation
Case "Bangalore"
isLocationWorkday = isBloreWorkday(pDate)
Case Else
isLocationWorkday = isUsWorkday(pDate)
End Select
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns the number of workdays in the selected location within a given calendar date range
'
' return
' the number of workdays between pStart and pEnd (inclusive)
'
' param
' pLocation is a String name for the location for which the holiday calendar is applied.
' param
' pStart is the first date of the calender date range
' param
' pEnd is the last date of the calender date range
' -----------------------------------------------------------------------------------------------------------
Public Function locationWorkdaysInCalendarPeriod(pLocation As String, pStart As Date, pEnd As Date) As Long
Select Case pLocation
Case "Bangalore"
locationWorkdaysInCalendarPeriod = bloreWorkdaysInCalendarPeriod(pStart, pEnd)
Case Else
locationWorkdaysInCalendarPeriod = usWorkdaysInCalendarPeriod(pStart, pEnd)
End Select
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns the number of calendar days in the selected location it takes to provide the given
' number of workdays
'
' return
' number of calendar days in the selected location it takes to provide the given number of workdays
'
' param
' pLocation is a String name for the location for which the holiday calendar is applied.
' param
' pStart is the calendar date to start searching for workdays from
' param
' pWorkdays is the number of workdays to find
' -----------------------------------------------------------------------------------------------------------
Public Function locationWorkdaysToCalendardays(pLocation As String, pStart As Date, pWorkdays As Double) As Double
Select Case pLocation
Case "Bangalore"
locationWorkdaysToCalendardays = bloreWorkdaysToCalendardays(pStart, pWorkdays)
Case Else
locationWorkdaysToCalendardays = usWorkdaysToCalendardays(pStart, pWorkdays)
End Select
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns the date that is the specified number of workdays prior to the given date.
'
' return
' this function returns the date that is the specified number of workdays prior to the given date. if
' pNumberOfWorkdays is 0 or less and pDate is a workday, this function returns pDate. if
' pNumberOfWorkdays is 0 or less and pDate is not a workday, this function returns the first workday
' prior to pDate.
'
' param
' pLocation is a String name for the location for which the holiday calendar is applied.
' param
' pDate is the date from which the number of workdays specified by pNumberOfWorkdays is subtracted.
' param
' pNumberOfWorkdays is the number of workdays to subtract from pDate.
' -----------------------------------------------------------------------------------------------------------
Public Function locationWorkdayPrior(pLocation As String, pDate As Date, pNumberOfWorkdays As Integer) As Date
Select Case pLocation
Case "Bangalore"
locationWorkdayPrior = bloreWorkdayPrior(pDate, pNumberOfWorkdays)
Case Else
locationWorkdayPrior = usWorkdayPrior(pDate, pNumberOfWorkdays)
End Select
End Function
' =====================================================================================================================
' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<[ Bangalore-Specific DateTime Utilities ]>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
' =====================================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns true if the given date is a workday in Bangalore, otherwise, it returns false
'
' return
' true if the given date is a workday in Bangalore, otherwise, it returns false
'
' param
' pDate is the day to test to see if it is a workday in Bangalore
' -----------------------------------------------------------------------------------------------------------
Public Function isBloreWorkday(pDate As Date) As Boolean
isBloreWorkday = Not (isWeekendDay(pDate) Or isHolidayClosure(pDate) Or isBloreHoliday(pDate))
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns the number of workdays in Bangalore within a given calendar date range
'
' return
' the number of workdays between pStart and pEnd (inclusive)
'
' param
' pStart is the first date of the calender date range
' param
' pEnd is the last date of the calender date range
' -----------------------------------------------------------------------------------------------------------
Public Function bloreWorkdaysInCalendarPeriod(pStart As Date, pEnd As Date) As Long
Dim thisDate As Date
thisDate = DateValue(pStart)
bloreWorkdaysInCalendarPeriod = 0
While thisDate <= pEnd
If isBloreWorkday(thisDate) Then
bloreWorkdaysInCalendarPeriod = bloreWorkdaysInCalendarPeriod + 1
End If
thisDate = thisDate + 1
Wend
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns the number of calendar days in Bangalore it takes to provide the given number of
' workdays
'
' return
' number of calendar days in Bangalore it takes to provide the given number of workdays
'
' param
' pStart is the calendar date to start searching for workdays from
' param
' pWorkdays is the number of workdays to find
' -----------------------------------------------------------------------------------------------------------
Public Function bloreWorkdaysToCalendardays(pStart As Date, pWorkdays As Double) As Double
Dim caldays As Double
Dim workdaysRemaining As Double
Dim currday As Date
Dim startdayRemaining As Double
Dim allocated As Double
caldays = 0#
workdaysRemaining = pWorkdays
If workdaysRemaining > 0# Then
currday = CDate(Int(pStart))
startdayRemaining = 1 - (pStart - currday)
'
' ==============================================================================================
' use up what's left of the starting calendar day
' ----------------------------------------------------------------------------------------------
If isBloreWorkday(currday) Then
allocated = min(workdaysRemaining, startdayRemaining)
workdaysRemaining = workdaysRemaining - allocated
caldays = allocated
Else
caldays = startdayRemaining
End If
currday = currday + 1#
'
' ==============================================================================================
' now accumulate calendar days and quit when enough have been accumulated to cover the
' remaining workdays
' ----------------------------------------------------------------------------------------------
While workdaysRemaining > 0#
If isBloreWorkday(currday) Then
allocated = min(workdaysRemaining, 1#)
workdaysRemaining = workdaysRemaining - allocated
caldays = caldays + allocated
Else
caldays = caldays + 1#
End If
currday = currday + 1#
Wend
End If
bloreWorkdaysToCalendardays = caldays
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns the date that is the specified number of workdays prior to the given date.
'
' return
' this function returns the date that is the specified number of workdays prior to the given date. if
' pNumberOfWorkdays is 0 or less and pDate is a workday, this function returns pDate. if
' pNumberOfWorkdays is 0 or less and pDate is not a workday, this function returns the first workday
' prior to pDate.
'
' param
' pDate is the date from which the number of workdays specified by pNumberOfWorkdays is subtracted.
' param
' pNumberOfWorkdays is the number of workdays to subtract from pDate.
' -----------------------------------------------------------------------------------------------------------
Public Function bloreWorkdayPrior(pDate As Date, pNumberOfWorkdays As Integer) As Date
Dim currentDate As Date
currentDate = pDate
If pNumberOfWorkdays <= 0 Then
If Not isBloreWorkday(pDate) Then
pNumberOfWorkdays = 1
End If
End If
While pNumberOfWorkdays > 0
currentDate = currentDate - 1
If isBloreWorkday(currentDate) Then
pNumberOfWorkdays = pNumberOfWorkdays - 1
End If
Wend
bloreWorkdayPrior = currentDate
End Function
' =====================================================================================================================
' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<[ USA-Specific DateTime Utilities ]>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
' =====================================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns true if the given date is a workday in the US, otherwise, it returns false
'
' return
' true if the given date is a workday in the US, otherwise, it returns false
'
' param
' pDate is the day to test to see if it is a workday in the US
' -----------------------------------------------------------------------------------------------------------
Public Function isUsWorkday(pDate As Date) As Boolean
isUsWorkday = Not (isWeekendDay(pDate) Or isHolidayClosure(pDate) Or isUsHoliday(pDate))
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns the number of workdays in the US within a given calendar date range
'
' return
' the number of workdays between pStart and pEnd (inclusive)
'
' param
' pStart is the first date of the calender date range
' param
' pEnd is the last date of the calender date range
' -----------------------------------------------------------------------------------------------------------
Public Function usWorkdaysInCalendarPeriod(pStart As Date, pEnd As Date) As Long
Dim thisDate As Date
thisDate = DateValue(pStart)
usWorkdaysInCalendarPeriod = 0
While thisDate <= pEnd
If isUsWorkday(thisDate) Then
usWorkdaysInCalendarPeriod = usWorkdaysInCalendarPeriod + 1
End If
thisDate = thisDate + 1
Wend
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns the number of calendar days in the US it takes to provide the given number of
' workdays
'
' return
' number of calendar days in the US it takes to provide the given number of workdays
'
' param
' pStart is the calendar date to start searching for workdays from
' param
' pWorkdays is the number of workdays to find
' -----------------------------------------------------------------------------------------------------------
Public Function usWorkdaysToCalendardays(pStart As Date, pWorkdays As Double) As Double
Dim caldays As Double
Dim workdaysRemaining As Double
Dim currday As Date
Dim startdayRemaining As Double
Dim allocated As Double
caldays = 0#
workdaysRemaining = pWorkdays
If workdaysRemaining > 0# Then
currday = CDate(Int(pStart))
startdayRemaining = 1 - (pStart - currday)
'
' ==============================================================================================
' use up what's left of the starting calendar day
' ----------------------------------------------------------------------------------------------
If isUsWorkday(currday) Then
allocated = min(workdaysRemaining, startdayRemaining)
workdaysRemaining = workdaysRemaining - allocated
caldays = allocated
Else
caldays = startdayRemaining
End If
currday = currday + 1#
'
' ==============================================================================================
' now accumulate calendar days and quit when enough have been accumulated to cover the
' remaining workdays
' ----------------------------------------------------------------------------------------------
While workdaysRemaining > 0#
If isUsWorkday(currday) Then
allocated = min(workdaysRemaining, 1#)
workdaysRemaining = workdaysRemaining - allocated
caldays = caldays + allocated
Else
caldays = caldays + 1#
End If
currday = currday + 1#
Wend
End If
usWorkdaysToCalendardays = caldays
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns the date that is the specified number of workdays prior to the given date.
'
' return
' this function returns the date that is the specified number of workdays prior to the given date. if
' pNumberOfWorkdays is 0 or less and pDate is a workday, this function returns pDate. if
' pNumberOfWorkdays is 0 or less and pDate is not a workday, this function returns the first workday
' prior to pDate.
'
' param
' pDate is the date from which the number of workdays specified by pNumberOfWorkdays is subtracted.
' param
' pNumberOfWorkdays is the number of workdays to subtract from pDate.
' -----------------------------------------------------------------------------------------------------------
Public Function usWorkdayPrior(pDate As Date, pNumberOfWorkdays As Integer) As Date
Dim currentDate As Date
currentDate = pDate
If pNumberOfWorkdays <= 0 Then
If Not isUsWorkday(pDate) Then
pNumberOfWorkdays = 1
End If
End If
While pNumberOfWorkdays > 0
currentDate = currentDate - 1
If isUsWorkday(currentDate) Then
pNumberOfWorkdays = pNumberOfWorkdays - 1
End If
Wend
usWorkdayPrior = currentDate
End Function
' =====================================================================================================================
' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<[ User-Specific DateTime Utilities ]>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
' =====================================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns true if the given date is a workday for User, otherwise, it returns false
'
' return
' true if the given date is a workday for User, otherwise, it returns false
'
' param
' pDate is the day to test to see if it is a workday for User
' -----------------------------------------------------------------------------------------------------------
Public Function isUserWorkday(pDate As Date) As Boolean
isUserWorkday = Not (isWeekendDay(pDate) Or isHolidayClosure(pDate) Or isMyVacation(pDate))
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns the number of workdays for User within a given calendar date range
'
' return
' the number of workdays between pStart and pEnd (inclusive)
'
' param
' pStart is the first date of the calender date range
' param
' pEnd is the last date of the calender date range
' -----------------------------------------------------------------------------------------------------------
Public Function userWorkdaysInCalendarPeriod(pStart As Date, pEnd As Date) As Long
Dim thisDate As Date
thisDate = DateValue(pStart)
userWorkdaysInCalendarPeriod = 0
While thisDate <= pEnd
If isUserWorkday(thisDate) Then
userWorkdaysInCalendarPeriod = userWorkdaysInCalendarPeriod + 1
End If
thisDate = thisDate + 1
Wend
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns the number of calendar days for User to provide the given number of workdays
'
' return
' number of calendar days it takes for User to provide the given number of workdays
'
' param
' pStart is the calendar date to start searching for workdays from
' param
' pWorkdays is the number of workdays to find
' param
' pVacationDays is a range containing each date that the user will take as a vacation day
' -----------------------------------------------------------------------------------------------------------
Public Function userWorkdaysToCalendardays(pStart As Date, pWorkdays As Double) As Double
Dim caldays As Double
Dim workdaysRemaining As Double
Dim currday As Date
Dim startdayRemaining As Double
Dim allocated As Double
caldays = 0#
workdaysRemaining = pWorkdays
If workdaysRemaining > 0# Then
currday = CDate(Int(pStart))
startdayRemaining = 1 - (pStart - currday)
'
' ==============================================================================================
' use up what's left of the starting calendar day
' ----------------------------------------------------------------------------------------------
If isUserWorkday(currday) Then
allocated = min(workdaysRemaining, startdayRemaining)
workdaysRemaining = workdaysRemaining - allocated
caldays = allocated
Else
caldays = startdayRemaining
End If
currday = currday + 1#
'
' ==============================================================================================
' now accumulate calendar days and quit when enough have been accumulated to cover the
' remaining workdays
' ----------------------------------------------------------------------------------------------
While workdaysRemaining > 0#
If isUserWorkday(currday) Then
allocated = min(workdaysRemaining, 1#)
workdaysRemaining = workdaysRemaining - allocated
caldays = caldays + allocated
Else
caldays = caldays + 1#
End If
currday = currday + 1#
Wend
End If
userWorkdaysToCalendardays = caldays
End Function
' =====================================================================================================================
' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<[ Timezone Conversions ]>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
' =====================================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function translates the system date/time and time zone on this computer to the current date/time in
' the India time zone.
'
' return
' the current date/tinme in the India time zone
' -----------------------------------------------------------------------------------------------------------
Public Function getCurrentIndiaTime() As Double
Dim retval As Long
Dim buffer(0 To 42) As Long
Const TIME_ZONE_ID_INVALID = &HFFFFFFFF
Const TIME_ZONE_ID_UNKNOWN = 0
Const TIME_ZONE_ID_STANDARD = 1
Const TIME_ZONE_ID_DAYLIGHT = 2
retval = GetTimeZoneInformationAny(buffer(0))
'
' ==============================================================================================
' default result
' ----------------------------------------------------------------------------------------------
Dim offsetFromUTCforThisComputer As Integer
Dim currentTime As Double
Select Case retval
Case TIME_ZONE_ID_INVALID
offsetFromUTCforThisComputer = 0
Case TIME_ZONE_ID_STANDARD, TIME_ZONE_ID_UNKNOWN
offsetFromUTCforThisComputer = (buffer(0) + buffer(21)) / -60
Case TIME_ZONE_ID_DAYLIGHT
offsetFromUTCforThisComputer = (buffer(0) + buffer(42)) / -60
Case Else
offsetFromUTCforThisComputer = 0
End Select
'
' ==============================================================================================
' convert to UTC
' ----------------------------------------------------------------------------------------------
currentTime = Now() - (offsetFromUTCforThisComputer / 24#)
'
' ==============================================================================================
' convert to India time
' ----------------------------------------------------------------------------------------------
getCurrentIndiaTime = currentTime + (5.5 / 24#)
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function converts a date/time from India Standard Time to another specified time zone. It
' compensates for daylight saving time.
'
' return
' the date/time in pFromTime adjusted to the time zone identified by pToZoneName.
'
' param
' pIndiaTime is the data/time in India Standard Time to convert from
' param
' pToZoneName identifies the target time zone to convert pFromTime to
' -----------------------------------------------------------------------------------------------------------
Public Function convertFromIndiaTime(pIndiaTime As Double, pToZoneName As String) As Double '
'
' ==============================================================================================
' call the time zone converter for the time zone identified by pToZoneName
' ----------------------------------------------------------------------------------------------
convertFromIndiaTime = 0
If (InStr(pToZoneName, "US E")) Then
convertFromIndiaTime = convertFromIndiaToUSE(pIndiaTime)
ElseIf (InStr(pToZoneName, "US C")) Then
convertFromIndiaTime = convertFromIndiaToUSC(pIndiaTime)
ElseIf (InStr(pToZoneName, "US M")) Then
convertFromIndiaTime = convertFromIndiaToUSM(pIndiaTime)
ElseIf (InStr(pToZoneName, "US P")) Then
convertFromIndiaTime = convertFromIndiaToUSP(pIndiaTime)
ElseIf (InStr(pToZoneName, "Mexi")) Then
convertFromIndiaTime = convertFromIndiaToMexi(pIndiaTime)
ElseIf (InStr(pToZoneName, "UTC/")) Then
convertFromIndiaTime = convertFromIndiaToUTC(pIndiaTime)
ElseIf (InStr(pToZoneName, "Irel")) Then
convertFromIndiaTime = convertFromIndiaToIrel(pIndiaTime)
ElseIf (InStr(pToZoneName, "Neth")) Then
convertFromIndiaTime = convertFromIndiaToNeth(pIndiaTime)
ElseIf (InStr(pToZoneName, "Indi")) Then
convertFromIndiaTime = pIndiaTime
ElseIf (InStr(pToZoneName, "Sing")) Then
convertFromIndiaTime = convertFromIndiaToSing(pIndiaTime)
End If
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function converts a date/time from India Standard Time to the US Eastern time zone. It compensates
' for daylight saving time.
'
' return
' the date/time in pFromTime adjusted to the US Eastern time zone
'
' param
' pIndiaTime is the data/time in India Standard Time to convert from
' -----------------------------------------------------------------------------------------------------------
Public Function convertFromIndiaToUSE(pIndiaTime As Double) As Double
'
' ==============================================================================================
' constants for the UTC offset and DST adjustment for this time zone
' ----------------------------------------------------------------------------------------------
Const toZoneOffset As Double = (-5) / 24#
Const toDstAdjust As Double = 1 / 24#
'
' ==============================================================================================
' convert
' ----------------------------------------------------------------------------------------------
convertFromIndiaToUSE = convertFromIndiaToUSAny(pIndiaTime, toZoneOffset, toDstAdjust)
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function converts a date/time from India Standard Time to the US Central time zone. It compensates
' for daylight saving time.
'
' return
' the date/time in pFromTime adjusted to the US Central time zone
'
' param
' pIndiaTime is the data/time in India Standard Time to convert from
' -----------------------------------------------------------------------------------------------------------
Public Function convertFromIndiaToUSC(pIndiaTime As Double) As Double
'
' ==============================================================================================
' constants for the UTC offset and DST adjustment for this time zone
' ----------------------------------------------------------------------------------------------
Const toZoneOffset As Double = (-6) / 24#
Const toDstAdjust As Double = 1 / 24#
'
' ==============================================================================================
' convert
' ----------------------------------------------------------------------------------------------
convertFromIndiaToUSC = convertFromIndiaToUSAny(pIndiaTime, toZoneOffset, toDstAdjust)
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function converts a date/time from India Standard Time to the US Mountain time zone. It compensates
' for daylight saving time.
'
' return
' the date/time in pFromTime adjusted to the US Mountain time zone
'
' param
' pIndiaTime is the data/time in India Standard Time to convert from
' -----------------------------------------------------------------------------------------------------------
Public Function convertFromIndiaToUSM(pIndiaTime As Double) As Double
'
' ==============================================================================================
' constants for the UTC offset and DST adjustment for this time zone
' ----------------------------------------------------------------------------------------------
Const toZoneOffset As Double = (-7) / 24#
Const toDstAdjust As Double = 1 / 24#
'
' ==============================================================================================
' convert
' ----------------------------------------------------------------------------------------------
convertFromIndiaToUSM = convertFromIndiaToUSAny(pIndiaTime, toZoneOffset, toDstAdjust)
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function converts a date/time from India Standard Time to the US Pacific time zone. It compensates
' for daylight saving time.
'
' return
' the date/time in pFromTime adjusted to the US Pacific time zone
'
' param
' pIndiaTime is the data/time in India Standard Time to convert from
' -----------------------------------------------------------------------------------------------------------
Public Function convertFromIndiaToUSP(pIndiaTime As Double) As Double
'
' ==============================================================================================
' constants for the UTC offset and DST adjustment for this time zone
' ----------------------------------------------------------------------------------------------
Const toZoneOffset As Double = (-8) / 24#
Const toDstAdjust As Double = 1 / 24#
'
' ==============================================================================================
' convert
' ----------------------------------------------------------------------------------------------
convertFromIndiaToUSP = convertFromIndiaToUSAny(pIndiaTime, toZoneOffset, toDstAdjust)
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function converts a date/time from India Standard Time to any US time zone. It compensates for
' daylight saving time.
'
' return
' the date/time in pFromTime adjusted to the US time zone
'
' param
' pIndiaTime is the data/time in India Standard Time to convert from
' -----------------------------------------------------------------------------------------------------------
Public Function convertFromIndiaToUSAny(pIndiaTime As Double, ByVal pToZoneOffset As Double, ByVal pToDstAdjust As Double) As Double
'
' ==============================================================================================
' constant for the UTC offset for the India zone
' ----------------------------------------------------------------------------------------------
Const indiaZoneOffset As Double = 5.5 / 24#
'
' ==============================================================================================
' convert to non DST adjustment time
' ----------------------------------------------------------------------------------------------
convertFromIndiaToUSAny = (pIndiaTime - indiaZoneOffset + pToZoneOffset)
'
' ==============================================================================================
' Figure out if toLocalTime falls withing a DST window, and if so, apply its DST adjustment
' ----------------------------------------------------------------------------------------------
Dim inDst As Boolean
Dim dstDates(12) As Double
dstDates(0) = 39516.0833333333 '2008 DST starts
dstDates(1) = 39754.0416666667 '2008 DST ends
dstDates(2) = 39880.0833333333 '2009 DST starts
dstDates(3) = 40118.0416666667 '2009 DST ends
dstDates(4) = 40251.0833333333 '2010 DST starts
dstDates(5) = 40489.0416666667 '2010 DST ends
dstDates(6) = 40615.0833333333 '2011 DST starts
dstDates(7) = 40853.0416666667 '2011 DST ends
dstDates(8) = 40979.0833333333 '2012 DST starts
dstDates(9) = 41217.0416666667 '2012 DST ends
dstDates(10) = 41343.0833333333 '2013 DST starts
dstDates(11) = 41581.0416666667 '2013 DST ends
inDst = False
Dim idx As Integer
For idx = 0 To 11
If convertFromIndiaToUSAny < dstDates(idx) Then
If inDst Then
convertFromIndiaToUSAny = convertFromIndiaToUSAny + pToDstAdjust
End If
Exit For
End If
inDst = Not inDst
Next idx
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function converts a date/time from India Standard Time to the Mexico City time zone. It compensates
' for daylight saving time.
'
' return
' the date/time in pFromTime adjusted to the Mexico City time zone
'
' param
' pIndiaTime is the data/time in India Standard Time to convert from
' -----------------------------------------------------------------------------------------------------------
Public Function convertFromIndiaToMexi(pIndiaTime As Double) As Double
'
' ==============================================================================================
' constants for the UTC offset and DST adjustment for India zone and this time zone
' ----------------------------------------------------------------------------------------------
Const indiaZoneOffset As Double = 5.5 / 24#
Const toZoneOffset As Double = (-6) / 24#
Const toDstAdjust As Double = 1 / 24#
'
' ==============================================================================================
' convert to non DST adjustment time
' ----------------------------------------------------------------------------------------------
convertFromIndiaToMexi = (pIndiaTime - indiaZoneOffset + toZoneOffset)
'
' ==============================================================================================
' Figure out if toLocalTime falls withing a DST window, and if so, apply its DST adjustment
' ----------------------------------------------------------------------------------------------
Dim inDst As Boolean
Dim dstDates(12) As Double
dstDates(0) = 39544.0833333333 '2008 DST starts
dstDates(1) = 39747.0416666667 '2008 DST ends
dstDates(2) = 39908.0833333333 '2009 DST starts
dstDates(3) = 40111.0416666667 '2009 DST ends
dstDates(4) = 40272.0833333333 '2010 DST starts
dstDates(5) = 40482.0416666667 '2010 DST ends
dstDates(6) = 40636.0833333333 '2011 DST starts
dstDates(7) = 40846.0416666667 '2011 DST ends
dstDates(8) = 41000.0833333333 '2012 DST starts
dstDates(9) = 41210.0416666667 '2012 DST ends
dstDates(10) = 41371.0833333333 '2013 DST starts
dstDates(11) = 41574.0416666667 '2013 DST ends
inDst = False
Dim idx As Integer
For idx = 0 To 11
If convertFromIndiaToMexi < dstDates(idx) Then
If inDst Then
convertFromIndiaToMexi = convertFromIndiaToMexi + toDstAdjust
End If
Exit For
End If
inDst = Not inDst
Next idx
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function converts a date/time from India Standard Time to the Ireland/UK time zone. It compensates
' for daylight saving time.
'
' return
' the date/time in pFromTime adjusted to the Ireland/UK time zone
'
' param
' pIndiaTime is the data/time in India Standard Time to convert from
' -----------------------------------------------------------------------------------------------------------
Public Function convertFromIndiaToIrel(pIndiaTime As Double) As Double
'
' ==============================================================================================
' constants for the UTC offset and DST adjustment for India zone and this time zone
' ----------------------------------------------------------------------------------------------
Const indiaZoneOffset As Double = 5.5 / 24#
Const toZoneOffset As Double = 0
Const toDstAdjust As Double = 1 / 24#
'
' ==============================================================================================
' convert to non DST adjustment time
' ----------------------------------------------------------------------------------------------
convertFromIndiaToIrel = (pIndiaTime - indiaZoneOffset + toZoneOffset)
'
' ==============================================================================================
' Figure out if toLocalTime falls withing a DST window, and if so, apply its DST adjustment
' ----------------------------------------------------------------------------------------------
Dim inDst As Boolean
Dim dstDates(12) As Double
dstDates(0) = 39537.0416666667 '2008 DST starts
dstDates(1) = 39747# '2008 DST ends
dstDates(2) = 39901.0416666667 '2009 DST starts
dstDates(3) = 40111# '2009 DST ends
dstDates(4) = 40265.0416666667 '2010 DST starts
dstDates(5) = 40482# '2010 DST ends
dstDates(6) = 40629.0416666667 '2011 DST starts
dstDates(7) = 40846# '2011 DST ends
dstDates(8) = 40993.0416666667 '2012 DST starts
dstDates(9) = 41210# '2012 DST ends
dstDates(10) = 41364.0416666667 '2013 DST starts
dstDates(11) = 41574# '2013 DST ends
inDst = False
Dim idx As Integer
For idx = 0 To 11
If convertFromIndiaToIrel < dstDates(idx) Then
If inDst Then
convertFromIndiaToIrel = convertFromIndiaToIrel + toDstAdjust
End If
Exit For
End If
inDst = Not inDst
Next idx
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function converts a date/time from India Standard Time to the Netherlands time zone. It compensates
' for daylight saving time.
'
' return
' the date/time in pFromTime adjusted to the Netherlands time zone
'
' param
' pIndiaTime is the data/time in India Standard Time to convert from
' -----------------------------------------------------------------------------------------------------------
Public Function convertFromIndiaToNeth(pIndiaTime As Double) As Double
'
' ==============================================================================================
' constants for the UTC offset and DST adjustment for India zone and this time zone
' ----------------------------------------------------------------------------------------------
Const indiaZoneOffset As Double = 5.5 / 24#
Const toZoneOffset As Double = 1 / 24#
Const toDstAdjust As Double = 1 / 24#
'
' ==============================================================================================
' convert to non DST adjustment time
' ----------------------------------------------------------------------------------------------
convertFromIndiaToNeth = (pIndiaTime - indiaZoneOffset + toZoneOffset)
'
' ==============================================================================================
' Figure out if toLocalTime falls withing a DST window, and if so, apply its DST adjustment
' ----------------------------------------------------------------------------------------------
Dim inDst As Boolean
Dim dstDates(12) As Double
dstDates(0) = 39537.0833333333 '2008 DST starts
dstDates(1) = 39747.0416666667 '2008 DST ends
dstDates(2) = 39901.0833333333 '2009 DST starts
dstDates(3) = 40111.0416666667 '2009 DST ends
dstDates(4) = 40265.0833333333 '2010 DST starts
dstDates(5) = 40482.0416666667 '2010 DST ends
dstDates(6) = 40629.0833333333 '2011 DST starts
dstDates(7) = 40846.0416666667 '2011 DST ends
dstDates(8) = 40993.0833333333 '2012 DST starts
dstDates(9) = 41210.0416666667 '2012 DST ends
dstDates(10) = 41364.0833333333 '2013 DST starts
dstDates(11) = 41574.0416666667 '2013 DST ends
inDst = False
Dim idx As Integer
For idx = 0 To 11
If convertFromIndiaToNeth < dstDates(idx) Then
If inDst Then
convertFromIndiaToNeth = convertFromIndiaToNeth + toDstAdjust
End If
Exit For
End If
inDst = Not inDst
Next idx
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function converts a date/time from India Standard Time to the UTC time zone.
'
' return
' the date/time in pFromTime adjusted to the UTC time zone
'
' param
' pIndiaTime is the data/time in India Standard Time to convert from
' -----------------------------------------------------------------------------------------------------------
Public Function convertFromIndiaToUTC(pIndiaTime As Double) As Double
'
' ==============================================================================================
' constants for the UTC offset and DST adjustment for India zone and this time zone
' ----------------------------------------------------------------------------------------------
Const indiaZoneOffset As Double = 5.5 / 24#
Const toZoneOffset As Double = 0 / 24#
'
' ==============================================================================================
' convert to non DST adjustment time
' ----------------------------------------------------------------------------------------------
convertFromIndiaToUTC = (pIndiaTime - indiaZoneOffset + toZoneOffset)
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function converts a date/time from India Standard Time to the Singapore time zone.
'
' return
' the date/time in pFromTime adjusted to the Singapore time zone
'
' param
' pIndiaTime is the data/time in India Standard Time to convert from
' -----------------------------------------------------------------------------------------------------------
Public Function convertFromIndiaToSing(pIndiaTime As Double) As Double
'
' ==============================================================================================
' constants for the UTC offset and DST adjustment for India zone and this time zone
' ----------------------------------------------------------------------------------------------
Const indiaZoneOffset As Double = 5.5 / 24#
Const toZoneOffset As Double = 8 / 24#
'
' ==============================================================================================
' convert to non DST adjustment time
' ----------------------------------------------------------------------------------------------
convertFromIndiaToSing = (pIndiaTime - indiaZoneOffset + toZoneOffset)
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns the date that DST (Daylight Savings Time) begins in a specified year and timezone.
'
' return
' the date that DST (Daylight Savings Time) begins in a specified year and timezone.
'
' param
' pYear is the year for which the DST start date is returned. This function will return CDate(0) for any
' year prior to 2008
' param
' pZone is the timezone for which the DST start date is returned. These are the values for which this
' function will compute a DST start date:
' "US" : any US timezone
' "ME" : the Mexico City timezone
' "IR" : the Ireland timezone
' "NE" : the Netherlands timezone
' -----------------------------------------------------------------------------------------------------------
Public Function getStartDST(pYear As Long, pZone As String) As Date
Dim startDate As Date
'
' ==============================================================================================
' Default result
' ----------------------------------------------------------------------------------------------
getStartDST = CDate(0)
If (pYear < 2008) Then
Exit Function
End If
'
' ==============================================================================================
' Depending on the timezone specified
' ----------------------------------------------------------------------------------------------
Select Case Left(UCase(pZone), 2)
'
' ==============================================================================================
' Any US timezone: Mar Sun>=8 02:00
' ----------------------------------------------------------------------------------------------
Case "US"
startDate = DateValue("March 8, " & pYear)
getStartDST = DateAdd("h", 2, nextDayOfWeek(startDate, "Sunday"))
'
' ==============================================================================================
' Mexico City timezone: Apr Sun>=1 02:00
' ----------------------------------------------------------------------------------------------
Case "ME"
startDate = DateValue("April 1, " & pYear)
getStartDST = DateAdd("h", 2, nextDayOfWeek(startDate, "Sunday"))
'
' ==============================================================================================
' Ireland timezone: Mar lastSun 01:00
' ----------------------------------------------------------------------------------------------
Case "IR"
startDate = DateValue("March 31, " & pYear)
getStartDST = DateAdd("h", 1, mostRecentDayOfWeek(startDate, "Sunday"))
'
' ==============================================================================================
' Netherlands timezone: Mar lastSun 02:00
' ----------------------------------------------------------------------------------------------
Case "NE"
startDate = DateValue("March 31, " & pYear)
getStartDST = DateAdd("h", 2, mostRecentDayOfWeek(startDate, "Sunday"))
End Select
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns the date that DST (Daylight Savings Time) ends in a specified year and timezone.
'
' return
' the date that DST (Daylight Savings Time) ends in a specified year and timezone.
'
' param
' pYear is the year for which the DST end date is returned. This function will return CDate(0) for any
' year prior to 2008
' param
' pZone is the timezone for which the DST end date is returned. These are the values for which this
' function will compute a DST end date:
' "US" : any US timezone
' "ME" : the Mexico City timezone
' "IR" : the Ireland timezone
' "NE" : the Netherlands timezone
' -----------------------------------------------------------------------------------------------------------
Public Function getEndDST(pYear As Long, pZone As String) As Date
Dim endDate As Date
'
' ==============================================================================================
' Default result
' ----------------------------------------------------------------------------------------------
getEndDST = CDate(0)
If (pYear < 2008) Then
Exit Function
End If
'
' ==============================================================================================
' Depending on the timezone specified
' ----------------------------------------------------------------------------------------------
Select Case Left(UCase(pZone), 2)
'
' ==============================================================================================
' Any US timezone: Nov Sun>=1 01:00
' ----------------------------------------------------------------------------------------------
Case "US"
endDate = DateValue("November 1, " & pYear)
getEndDST = DateAdd("h", 1, nextDayOfWeek(endDate, "Sunday"))
'
' ==============================================================================================
' Mexico City timezone: Oct lastSun 01:00
' ----------------------------------------------------------------------------------------------
Case "ME"
endDate = DateValue("October 31, " & pYear)
getEndDST = DateAdd("h", 1, mostRecentDayOfWeek(endDate, "Sunday"))
'
' ==============================================================================================
' Ireland timezone: Oct lastSun 00:00
' ----------------------------------------------------------------------------------------------
Case "IR"
endDate = DateValue("October 31, " & pYear)
getEndDST = mostRecentDayOfWeek(endDate, "Sunday")
'
' ==============================================================================================
' Netherlands timezone: Oct lastSun 01:00
' ----------------------------------------------------------------------------------------------
Case "NE"
endDate = DateValue("October 31, " & pYear)
getEndDST = DateAdd("h", 1, mostRecentDayOfWeek(endDate, "Sunday"))
End Select
End Function
' =====================================================================================================================
' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<[ Date Time Math ]>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
' =====================================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
'
' * UNDER CONSTRUCTION WITH THE OBJ OF HIGH RESOLUTION MATH
'
' This function returns the difference between two DateTimes in the units specified
'
' return
' a Long value specifying the number of time intervals between two DateTime values
'
' param
' pUnit is a String expression representing the time interval you want to use as the unit of difference
' between pDate1 and pDate2. pUnits may have any of these values:
' "yyyy" Year
' "q" Quarter
' "m" Month
' "y" Day of year
' "d" Day
' "w" Weekday
' "ww" Week
' "h" Hour
' "n" Minute
' "s" Second
' param
' pDateTime2 is the second DateTime value you want to use in the calculation.
' param
' pDateTime2 is the second DateTime value you want to use in the calculation.
' -----------------------------------------------------------------------------------------------------------
'Function dateTimeDiff(pDateTime1 As Date, pDateTime2 As Date, pUnit As String) As Long
' DateTimeDiff = DateDiff(pUnit, pDateTime1, pDateTime2)
'End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function exposes the VBA DateAdd() functionality at the application level (Excel, etc.).
'
' return
' Returns a Variant (Date) containing a date to which a specified time increment has been added.
'
' param
' pDateTime is a Variant (Date) or literal representing date-time to which the number of units of time is
' added.
' param
' pNumber is a numeric expression that is the number of units of time you want to add. It can be positive
' (to get dates in the future) or negative (to get dates in the past). If number isn't a Long value, it
' is rounded to the nearest whole number before being evaluated
' param
' pUnits is a string expression that is the units of time you want to add. pUnits may have any of these
' values:
' "yyyy" Year
' "q" Quarter
' "m" Month
' "y" Day of year
' "d" Day
' "w" Weekday
' "ww" Week
' "h" Hour
' "n" Minute
' "s" Second
' -----------------------------------------------------------------------------------------------------------
Public Function dateTimeAdd(pDateTime As Variant, pNumber As Variant, pUnits As String) As Variant
dateTimeAdd = DateAdd(pUnits, pNumber, pDateTime)
End Function
Public Function dateTimeSum(pDateTime As Date, pNumber As Double, pUnits As String) As Date
dateTimeSum = DateAdd(pUnits, pNumber, pDateTime)
End Function
Public Function dateTimeDiff(pDateTime1 As Date, pDateTime2, pUnits As String) As Long
dateTimeDiff = DateDiff(pUnits, pDateTime1, pDateTime2)
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' These functions convert a DateTime into various units with the units being identified in the function name.
'
' return
' The number of units in the DateTime
'
' param
' pDateTime is the DateTime to convert to start counting from
' -----------------------------------------------------------------------------------------------------------
Public Function dateTime2Years(pDateTime As Date) As Double
dateTime2Years = dateTime2Days(pDateTime) / cDaysPerYear
End Function
Public Function dateTime2Months(pDateTime As Date) As Double
dateTime2Months = dateTime2Years(pDateTime) * cMonthsPerYear
End Function
Public Function dateTime2Weeks(pDateTime As Date) As Double
dateTime2Weeks = dateTime2Months(pDateTime) * cWeeksPerMonth
End Function
Public Function dateTime2Days(pDateTime As Date) As Double
dateTime2Days = pDateTime
End Function
Public Function dateTime2Hours(pDateTime As Date) As Double
dateTime2Hours = dateTime2Days(pDateTime) * 24
End Function
Public Function dateTime2Minutes(pDateTime As Date) As Double
dateTime2Minutes = dateTime2Hours(pDateTime) * 60
End Function
Public Function dateTime2Seconds(pDateTime As Date) As Double
dateTime2Seconds = dateTime2Minutes(pDateTime) * 60
End Function
Public Function dateTime2Milliseconds(pDateTime As Date) As Double
dateTime2Milliseconds = dateTime2Seconds(pDateTime) * 1000
End Function
Public Function dateTime2Microseconds(pDateTime As Date) As Double
dateTime2Microseconds = dateTime2Seconds(pDateTime) * 1000000
End Function
Public Function dateTime2HundredNanoseconds(pDateTime As Date) As Double
dateTime2HundredNanoseconds = dateTime2Seconds(pDateTime) * 10000000
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This subroutine finds the number of weekdays between two dates
'
' return
' The number of week days in the range (earlyDate..lateDate). If earlyDate >= lateDate then this function
' returns a negative number.
'
' param
' pEarlyDate is the date to start counting from
' param
' pLateDate is the date to count to
' -----------------------------------------------------------------------------------------------------------
Public Function weekDaysBetween(pEarlyDate As Date, pLateDate As Date) As Double
weekDaysBetween = 0
'
' ==============================================================================================
' if they're the same date return 0 immediately
' ----------------------------------------------------------------------------------------------
If (pEarlyDate = pLateDate) Then
weekDaysBetween = 0
Exit Function
End If
'
' ==============================================================================================
' if the dates are in the wrong order, i.e., early > late, swap them and remember to negate the
' return value
' ----------------------------------------------------------------------------------------------
Dim needsNegation As Boolean
needsNegation = False
If (pEarlyDate > pLateDate) Then
Dim tmp As Date
tmp = pEarlyDate
pEarlyDate = pLateDate
pLateDate = tmp
needsNegation = True
End If
'
' ==============================================================================================
' The early day at time 0
' ----------------------------------------------------------------------------------------------
Dim startOfEarlyDate As Double
startOfEarlyDate = Fix(pEarlyDate)
'
' ==============================================================================================
' The day after pEarlyDate at time 0
' ----------------------------------------------------------------------------------------------
Dim startOfDayAfterEarlyDate As Double
startOfDayAfterEarlyDate = Fix(pEarlyDate + 1)
'
' ==============================================================================================
' The late day at time 0
' ----------------------------------------------------------------------------------------------
Dim startOfLateDate As Double
startOfLateDate = Fix(pLateDate)
'
' ==============================================================================================
' if the pEarlyDate and pLateDate are on the same day (but maybe not the same time), then the
' only time remaining is the difference in time. Figure out how much time that is, remember to
' negate it if the dates were swapped, and return the value immediately.
' ----------------------------------------------------------------------------------------------
If (startOfEarlyDate = startOfLateDate) Then
If (Weekday(startOfEarlyDate) <> 1 And Weekday(startOfEarlyDate) <> 7) Then
weekDaysBetween = pLateDate - pEarlyDate
If (needsNegation) Then
weekDaysBetween = -weekDaysBetween
End If
Else
weekDaysBetween = 0
End If
Exit Function
End If
'
' ==============================================================================================
' The fraction of a day available in pLateDate
' ----------------------------------------------------------------------------------------------
Dim lateDateFractionAvailable As Double
If (Weekday(pLateDate) <> 1 And Weekday(pLateDate) <> 7) Then
lateDateFractionAvailable = pLateDate - startOfLateDate
Else
lateDateFractionAvailable = 0
End If
'
' ==============================================================================================
' The fraction of a day remaining in pEarlyDate
' ----------------------------------------------------------------------------------------------
Dim earlyDateFractionAvailable As Double
If (Weekday(pEarlyDate) <> 1 And Weekday(pEarlyDate) <> 7) Then
earlyDateFractionAvailable = startOfDayAfterEarlyDate - pEarlyDate
Else
earlyDateFractionAvailable = 0
End If
'
' ==============================================================================================
' This is how many days are going to be checked to see if they are a weekday
' ----------------------------------------------------------------------------------------------
Dim daysBetween As Integer
daysBetween = startOfLateDate - startOfEarlyDate
'
' ==============================================================================================
' add up the days and the previously computed fractional days
' ----------------------------------------------------------------------------------------------
Dim dateToCheck As Date
Dim i As Integer
For i = 0 To daysBetween
dateToCheck = pEarlyDate + i
If (i = 0) Then
weekDaysBetween = weekDaysBetween + earlyDateFractionAvailable
ElseIf (i = daysBetween) Then
weekDaysBetween = weekDaysBetween + lateDateFractionAvailable
ElseIf (Weekday(dateToCheck) <> 1 And Weekday(dateToCheck) <> 7) Then
weekDaysBetween = weekDaysBetween + 1
End If
Next i
'
' ==============================================================================================
' Remember to negate it if the dates were swapped, and return the result
' ----------------------------------------------------------------------------------------------
If (needsNegation) Then
weekDaysBetween = -weekDaysBetween
End If
End Function
Facebook