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.
