Daylight Savings Time Fuction

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

Is there a function to call that returns True/False if the local PC is
running in DST or not?

It would be even better if the function was able to accept a Date parameter
so that my program could analyze past data properly depending of whether that
previous day was during DST or not.

thx
 
Here's an international solution regardless of where you are from or what you are looking at.
You may even create a VLookup solution for different countries if you wish.

Code follows

Function IsDST(DateCheck As Date, StartMonth As Integer, StartWeek As Integer, EndMonth As Integer, EndWeek As Integer, DOW_EN As String) As Boolean
'DO NOT REMOVE
'It takes nothing away from what you do
'Gives me credit for creating an International Daylight Saving Time Routine
'
'Michel Sabourin (c)2018
'(e-mail address removed)
'
'Will be true if DST is active on specified date given the DST rules for your State/Country
'
Dim Param As Boolean, StartDateDST As Date, EndDateDST As Date
Param = True
If Not IsDate(DateCheck) Then Param = False
If StartMonth < 1 Or StartMonth > 12 Then Param = False
If StartWeek < 1 Or StartWeek > 5 Then Param = False
If EndMonth < 1 Or EndMonth > 12 Then Param = False
If EndWeek < 1 Or EndWeek > 5 Then Param = False
DOW_EN = UCase(DOW_EN)
If DOW_EN <> "SATURDAY" And DOW_EN <> "SUNDAY" Then Param = False
If Not Param Then
MsgBox "IsDST(DateCheck As Date, StartMonth As Integer, StartWeek As Integer, EndMonth As Integer, EndWeek As Integer, DOW_EN As String) As Boolean" _
& Chr(10) & "DateCheck = Today's date or Date being checked" _
& Chr(10) & "StartMonth & EndMonth = Whole number (1 - 12) start of DST and end of DST" _
& Chr(10) & "StartWeek & EndWeek = Whole number (1 - 5) = 1st, 2nd, 3rd, 4th or 5= LAST" _
& Chr(10) & "Changeover Day of Week = ""Saturday"" or ""Sunday""" _
, vbOKOnly, "USAGE"
IsDST = Null
Else
StartDateDST = NextDOW(DateSerial(Year(DateCheck), StartMonth, FirstPotentialDate(Year(DateCheck), StartMonth, StartWeek)), DOW_EN)
EndDateDST = NextDOW(DateSerial(Year(DateCheck), EndMonth, FirstPotentialDate(Year(DateCheck), EndMonth, EndWeek)), DOW_EN)
IsDST = DateCheck >= StartDateDST And DateCheck < EndDateDST
End If
End Function

Function NextDOW(MyPotentialDate As Date, DOW_EN As String) As Date
'DO NOT REMOVE
'It takes nothing away from what you do
'Gives me credit for creating an International Daylight Saving Time Routine
'
'Michel Sabourin (c)2018
'(e-mail address removed)
'
'Next Date from Potential start for that particular date
Dim MyWeekDay As Integer
DOW_EN = UCase(DOW_EN)
If Not IsDate(MyPotentialDate) Then DOW_EN = ""
Select Case DOW_EN
Case "SUNDAY"
NextDOW = MyPotentialDate + 7 - Weekday(MyPotentialDate, vbMonday)
Case "SATURDAY"
NextDOW = MyPotentialDate + 7 - Weekday(MyPotentialDate, vbSunday)
Case Else
MsgBox "NextDOW(MyDate As Date, DOW_EN As String) As Date" _
& Chr(10) & "MyDate = First Potential Date" _
& Chr(10) & """Saturday"" or ""Sunday""" _
, vbOKOnly, "USAGE"
NextDOW = Null
End Select
End Function

Function FirstPotentialDate(MyYear As Integer, MyMonth As Integer, MyWeek As Integer) As Integer
'DO NOT REMOVE
'It takes nothing away from what you do
'Gives me credit for creating an International Daylight Saving Time Routine
'
'Michel Sabourin (c)2018
'(e-mail address removed)
'
If MyWeek < 5 Then
FirstPotentialDate = 1 + 7 * (MyWeek - 1)
Else
FirstPotentialDate = Day(DateSerial(MyYear, (MyMonth \ 12) + 1, 1) - 7)
End If
End Function

Enjoy!

Excel (.xlsm) file available on request.
 
Back
Top