1

This is my first time posting on Stackoverflow. I tried to find an answer to my question, and while this issue seems to have been addressed for other languages I didn't see any VBA specific solutions so I thought Id post here. I apologize if my due diligence was insufficient and I appreciate any help.

Basically, I would like to know if a given date entered on a userform was on on which daylight savigns time was in effect. I would like for the code to evaluate whether dst was in effect and if so populate a second text box with a message saying " Daylight savings" or something

Here is the code I came up with

Private Sub dtefrm_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)

Dim dte
Dim dstdte As Boolean


Let dte = CDate(Me.dtefrm.Value)


Select Case dte
    Case dte > CDate("3/9/2008") And dte < CDate("11/2/2008")
        dstdte = True
        Me.dayconf.Value = "Daylight Savings"

    End Select


End Sub

In this code, dtefrm is the name of the text box on the userform into which the user inputs the date, and dayconf is the text box on which I would like to display a message if the date entered is a DST date.

Thank you for any help you can give.

Community
  • 1
  • 1
brokenspiv
  • 23
  • 6

2 Answers2

0

I recommend a more permanent solution that doesn't have to be managed. So if the DST rules change you should be covered.

Step 1 - Create a VB.NET DLL that will do the IsDaylightSavingsTime call for you. It's smart enough to handle lots of information that your code won't consider.

The code should look like this.

Name the DLL DateTimeDstChecker so it's DateTimeDstChecker.dll

<Serializable(), ClassInterface(ClassInterfaceType.AutoDual), ComVisible(True)>
Public Class DateTimeDstChecker

    Public Function IsDst(ByVal checkDate As DateTime) As Boolean
        Return TimeZoneInfo.Local.IsDaylightSavingTime(thisTime)
    End Function
End Class

Step 2 - Add the Reference

Once you compile your assembly, you should be able to include a reference to it within VBA by going to "Tools > References" and find DateTimeDstChecker

Step 3 - Code the VBA

' Define the Variable
Dim checker As DateTimeDstChecker

' Instantiate the Var
Set checker = New DateTimeDstChecker

' Get the Information
isDst = checker.IsDst(CDate(Me.dtefrm.Value))
Ctznkane525
  • 7,297
  • 3
  • 16
  • 40
  • I'm afraid this is waaaay beyond the scope of my skills, which are admittedly not advanced at all this is actually the first time ive transitioned from writing formulas in columns to writing a VBA script lol. One day perhaps this will be something I can achieve, but I'm afraid at the moment I have a pressing deadline that precludes me from diving too deep into a whole new skill set (I'm not even 100% sure what a DLL is lol, also I don't know if making would would necessitate downloading additional IDE's or something, and I'm sure my IT department would back at letting me do install it) – brokenspiv Jan 05 '18 at 18:36
  • That said, thank you so much for taking the time to answer and I will definitely try to understand this solution when I have time so I knowfor the future. You guys are amazing! – brokenspiv Jan 05 '18 at 18:37
  • you start coding rules for DST...not a great idea. – Ctznkane525 Jan 05 '18 at 18:42
-1
    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
    'mpsabourin@gmail.com
    '
    '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
    'mpsabourin@gmail.com
    '
        '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
    'mpsabourin@gmail.com
    '
        If MyWeek < 5 Then
            FirstPotentialDate = 1 + 7 * (MyWeek - 1)
        Else
            FirstPotentialDate = Day(DateSerial(MyYear, (MyMonth \ 12) + 1, 1) - 7)
        End If
    End Function