Find First Sunday of month chosen function

**Ruegen** · 04-07-2014, 07:00 PM

fixed (if you care to check through it - I'd still appreciate it

)

Code:

Option Compare Database


Function DaylightSavings(StateID As Integer)






Dim intState As Integer
Dim cdatetime As Date
Dim TimeOffset As Integer
Dim strInterval As String
Dim FirstSunday1 As Date
Dim FirstSunday2 As Date
Dim FirstSunday3 As Date
Dim d1 As Date
Dim w1 As Integer


intState = StateID
'--------------------------------
   TimeOffset = 0
   strInterval = ""




D = DateSerial(Year(Date), 4, 1)
w = Weekday(D, vbSunday)
FirstSunday1 = D + IIf(w, 8 - w, 0)


D = DateSerial(Year(Date), 10, 1)
w = Weekday(D, vbSunday)
FirstSunday2 = D + IIf(w, 8 - w, 0)


D = DateSerial(Year(DateAdd("yyyy", 1, Date)), 4, 1)
w = Weekday(D, vbSunday)
FirstSunday3 = D + IIf(w, 8 - w, 0)




   'set default time
'--------------------------------
   TimeOffset = 0
   strInterval = ""


   'set default time and have Australian date converted to American
  cdatetime = Format(Date, "mm/dd/yyyy")
FirstSunday1 = Format(FirstSunday1, "mm/dd/yyyy")
FirstSunday2 = Format(FirstSunday2, "mm/dd/yyyy")
FirstSunday3 = Format(FirstSunday3, "mm/dd/yyyy")


   If "#" & cdatetime & "#" < "#" & FirstSunday1 & "#" Then




   Select Case intState
    Case 3
            TimeOffset = -90
            strInterval = "n"
     Case 4
            TimeOffset = -1
            strInterval = "h"
    Case 5
            TimeOffset = -30
            strInterval = "n"
    Case 8
            TimeOffset = -3
            strInterval = "h"
            
     End Select




         
ElseIf "#" & cdatetime & "#" > "#" & FirstSunday1 & "#" And "#" & cdatetime & "#" >= "#" & FirstSunday2 & "#" Then


     
          Select Case intState
    Case 3
            TimeOffset = -30
            strInterval = "n"
            
     Case 4
            TimeOffset = 0
            strInterval = "n"


    Case 5
            TimeOffset = -30
            strInterval = "n"
     Case 8
            TimeOffset = -2
            strInterval = "h"


      End Select
      




ElseIf "#" & cdatetime & "#" > "#" & FirstSunday2 & "#" And "#" & cdatetime & "#" >= "#" & FirstSunday3 & "#" Then


       Select Case intState
    Case 3
            TimeOffset = -90
            strInterval = "n"
     Case 4
            TimeOffset = -1
            strInterval = "h"
    Case 5
            TimeOffset = -30
            strInterval = "n"
    Case 8
            TimeOffset = -3
            strInterval = "h"
            
     End Select


End If


  If strInterval <> "" Then


     cdatetime = DateAdd(strInterval, TimeOffset, Now())
      Else
      cdatetime = Now()
      
   End If
   
   DaylightSavings = cdatetime








End Function

**Ruegen** · 04-15-2014, 06:49 PM

Sorry guys I have to bring this one back and I've totally given up now

The times are not corresponding correctly

the dates are correct

I have

Code:

Function DaylightSavings(StateID As Integer)


Dim intState As Integer
Dim cdatetime As Date
Dim TimeOffset As Integer
Dim strInterval As String
Dim FirstSunday1 As Date
Dim FirstSunday2 As Date
Dim FirstSunday3 As Date
Dim d1 As Date
Dim w1 As Integer




   'set default time
'--------------------------------
   TimeOffset = 0
   strInterval = ""
    intState = StateID


d = DateSerial(Year(Date), 4, 1)
w = Weekday(d, vbSunday)
FirstSunday1 = d + IIf(w, 8 - w, 0)


d = DateSerial(Year(Date), 10, 1)
w = Weekday(d, vbSunday)
FirstSunday2 = d + IIf(w, 8 - w, 0)


d = DateSerial(Year(DateAdd("yyyy", 1, Date)), 4, 1)
w = Weekday(d, vbSunday)
FirstSunday3 = d + IIf(w, 8 - w, 0)








   'set default time and have Australian date converted to American
  cdatetime = Format(Date, "mm/dd/yyyy")
FirstSunday1 = Format(FirstSunday1, "mm/dd/yyyy")
FirstSunday2 = Format(FirstSunday2, "mm/dd/yyyy")
FirstSunday3 = Format(FirstSunday3, "mm/dd/yyyy")






   If "#" & cdatetime & "#" < "#" & FirstSunday1 & "#" Then




   Select Case intState
    Case 3 'Northern Territory
            TimeOffset = -90
            strInterval = "n"
            
    Case 4 'Queensland
            TimeOffset = -1
            strInterval = "h"
            
    Case 5 'South Australia
            TimeOffset = -30
            strInterval = "n"
            
    Case 8 'Western Australia
            TimeOffset = -3
            strInterval = "h"
            
     End Select
Forms!frmSchools!box1.Value = "before daylight"


         
ElseIf "#" & cdatetime & "#" > "#" & FirstSunday1 & "#" And "#" & cdatetime & "#" <= "#" & FirstSunday2 & "#" Then


     
          Select Case intState
    Case 3 'Northern Territory
            TimeOffset = -30
            strInterval = "n"
            
    Case 4 'Queensland
            TimeOffset = 0
            strInterval = "n"


    Case 5 'South Australia
            TimeOffset = -30
            strInterval = "n"
            
    Case 8 'Western Australia
            TimeOffset = -2
            strInterval = "h"


      End Select
      
Forms!frmSchools!box1.Value = "after daylight"


ElseIf "#" & cdatetime & "#" > "#" & FirstSunday2 & "#" And "#" & cdatetime & "#" <= "#" & FirstSunday3 & "#" Then


       Select Case intState
    Case 3 'Northern Territory
            TimeOffset = -90
            strInterval = "n"
            
    Case 4 'Queensland
            TimeOffset = -1
            strInterval = "h"
            
    Case 5 'South Australia
            TimeOffset = -30
            strInterval = "n"
            
    Case 8 'Western Australia
            TimeOffset = -3
            strInterval = "h"
            
     End Select
     
Forms!frmSchools!box1.Value = "before daylight but after current"
End If


  If strInterval <> "" Then
Forms!frmSchools!box1.Value = "not applicable"
     cdatetime = DateAdd(strInterval, TimeOffset, Now())
      Else
      cdatetime = Now()
      
   End If
   
   DaylightSavings = cdatetime








End Function

**Ruegen** · 04-16-2014, 09:03 PM

Bump.

still not solved this one...

**Ruegen** · 04-19-2014, 04:42 AM

*cough

*cough

**June7** · 04-19-2014, 10:23 AM

All I can suggest is step debug. Set a breakpoint, call the function from the immediate window, follow the code as it executes.

**ItsMe** · 04-19-2014, 12:47 PM

Assuming using the format to assign an international date to a Date Variable is working correctly, have you tried adding the time to the format? "dd/mm/yyyy;hh:mm:ss"

If you are using data type Date in your table's fields, the date is stored as American, regardless of formatting. It may appear that it is stored as dd/mm/yyyy but , it is not. It is stored as a number (I believe Double) and displayed as literal text. Formatting is for the benefit of humans. Once it is a Date, additional formatting is extraneous.

When humans talk to an Access data type Date, they need to speak American Standard.

I do not understand what you are accomplishing with the following:
'set default time and have Australian date converted to American
cdatetime = Format(Date, "mm/dd/yyyy")

There is not any benefit to Access here, only Humans.

Consider this conversion exercise.

Code:

Dim strInternational As String
Dim strMonth As String
Dim strDate As String
Dim strYear As String
Dim strTime As String
Dim dtCurrent As Date
Dim dtCompare As Date
Dim lngAnswer As Long

'assign user input to string variable
strInternational = "28-2-2010 1:20:59 PM"
Debug.Print "strInternational = " & strInternational
'Extract the components
strDate = Left(strInternational, InStrRev(strInternational, "-") - 1)
strDate = Left(strDate, InStrRev(strDate, "-") - 1)
Debug.Print "strDate = " & strDate
strMonth = Right(strInternational, InStrRev(strInternational, " ") - 1)
strMonth = Left(strMonth, InStrRev(strMonth, "-") - 1)
Debug.Print "strMonth = " & strMonth
strYear = Mid(strInternational, InStrRev(strInternational, "-") + 1)
strYear = Left(strYear, InStrRev(strYear, " ", 7))
Debug.Print "strYear = " & strYear
strTime = Right(strInternational, InStr(strInternational, " "))
Debug.Print "strTime = " & strTime
'format to match American standard
dtCompare = strMonth & "-" & strDate & "-" & strYear & " " & strTime
Debug.Print "dtCompare = " & dtCompare
'Now that we have our user input defined as data type Date
'we can employ built in Date functions
dtCurrent = Now
lngAnswer = DateDiff("h", dtCurrent, dtCompare)
Debug.Print "Answer  = " & dblAnswer

If someone has an alternative to working with international dates in Access, I would like to see it. I use text as an input. Using a date field for International input is confusing. Use a formatted control to DISPLAY a Date field.

**Ruegen** · 04-21-2014, 08:24 PM

Originally Posted by ItsMe

Assuming using the format to assign an international date to a Date Variable is working correctly, have you tried adding the time to the format? "dd/mm/yyyy;hh:mm:ss"

If you are using data type Date in your table's fields, the date is stored as American, regardless of formatting. It may appear that it is stored as dd/mm/yyyy but , it is not. It is stored as a number (I believe Double) and displayed as literal text. Formatting is for the benefit of humans. Once it is a Date, additional formatting is extraneous.

When humans talk to an Access data type Date, they need to speak American Standard.

I do not understand what you are accomplishing with the following:
'set default time and have Australian date converted to American
cdatetime = Format(Date, "mm/dd/yyyy")

There is not any benefit to Access here, only Humans.

Consider this conversion exercise.

Code:

Dim strInternational As String
Dim strMonth As String
Dim strDate As String
Dim strYear As String
Dim strTime As String
Dim dtCurrent As Date
Dim dtCompare As Date
Dim lngAnswer As Long

'assign user input to string variable
strInternational = "28-2-2010 1:20:59 PM"
Debug.Print "strInternational = " & strInternational
'Extract the components
strDate = Left(strInternational, InStrRev(strInternational, "-") - 1)
strDate = Left(strDate, InStrRev(strDate, "-") - 1)
Debug.Print "strDate = " & strDate
strMonth = Right(strInternational, InStrRev(strInternational, " ") - 1)
strMonth = Left(strMonth, InStrRev(strMonth, "-") - 1)
Debug.Print "strMonth = " & strMonth
strYear = Mid(strInternational, InStrRev(strInternational, "-") + 1)
strYear = Left(strYear, InStrRev(strYear, " ", 7))
Debug.Print "strYear = " & strYear
strTime = Right(strInternational, InStr(strInternational, " "))
Debug.Print "strTime = " & strTime
'format to match American standard
dtCompare = strMonth & "-" & strDate & "-" & strYear & " " & strTime
Debug.Print "dtCompare = " & dtCompare
'Now that we have our user input defined as data type Date
'we can employ built in Date functions
dtCurrent = Now
lngAnswer = DateDiff("h", dtCurrent, dtCompare)
Debug.Print "Answer  = " & dblAnswer

If someone has an alternative to working with international dates in Access, I would like to see it. I use text as an input. Using a date field for International input is confusing. Use a formatted control to DISPLAY a Date field.

It's more the if statements, - I formatted the dates to american to cancel out that as the problem. If I know all the dates are correct - then there is something wrong with my if statements.

**Ruegen** · 04-22-2014, 11:19 PM

I've noticed that for me even formatting the date into

cdatetime = Format(cdatetime, "mm/dd/yyyy;hh:mm:ss")
'
MsgBox cdatetime

I still get 23/4/2014 instead of 4/23/2014 where as the other dates are not in the Australian format - this throws things out.

**Ruegen** · 04-22-2014, 11:22 PM

I've had to evaluate everything using If Format(Date, "dd/mm/yyyy;hh:mm:ss") > Format(FirstSunday2, "dd/mm/yyyy;hh:mm:ss") Then

and also next If statements

**Ruegen** · 04-22-2014, 11:41 PM

My changes

Code:

If Format(cdatetime, "dd/mm/yyyy;hh:mm:ss") > Format(FirstSunday1, "dd/mm/yyyy;hh:mm:ss") Then




                If Format(cdatetime, "dd/mm/yyyy;hh:mm:ss") > Format(FirstSunday2, "dd/mm/yyyy;hh:mm:ss") Then
                    
                    Select Case intState
                    Case 3 'Northern Territory
                            TimeOffset = -30
                            strInterval = "n"
                            
                    Case 4 'Queensland
                            TimeOffset = 0
                            strInterval = "n"
                
                    Case 5 'South Australia
                            TimeOffset = -30
                            strInterval = "n"
                            
                    Case 8 'Western Australia
                            TimeOffset = -2
                            strInterval = "h"
                
                    End Select


                
                Else
                    
                    Select Case intState
                    Case 3 'Northern Territory
                            TimeOffset = -90
                            strInterval = "n"
                            
                    Case 4 'Queensland
                            TimeOffset = -1
                            strInterval = "h"
                            
                    Case 5 'South Australia
                            TimeOffset = -30
                            strInterval = "n"
                            
                    Case 8 'Western Australia
                            TimeOffset = -3
                            strInterval = "h"
                            
                     End Select


                   
                End If
     
Else
        
        
        
                    Select Case intState
                    Case 3 'Northern Territory
                            TimeOffset = -90
                            strInterval = "n"
                            
                    Case 4 'Queensland
                            TimeOffset = -1
                            strInterval = "h"
                            
                    Case 5 'South Australia
                            TimeOffset = -30
                            strInterval = "n"
                            
                    Case 8 'Western Australia
                            TimeOffset = -3
                            strInterval = "h"
                
                    End Select
                
                     
End If

**ItsMe** · 04-23-2014, 09:10 AM

I still do not see any difference between
If Format(cdatetime, "dd/mm/yyyy;hh:mm:ss") > Format(FirstSunday1, "dd/mm/yyyy;hh:mm:ss") Then
and

If cdatetime > FirstSunday1 Then
or

If Format(cdatetime, "dd/mm/yyyy;hh:mm:ss") > Format(FirstSunday1, "yyyy/mm/dd;hh:mm:ss") Then
or even

If cdatetime > Format(FirstSunday1, "mm/dd/yyyy;hh_hello_world_mm:ss") Then

**rpeare** · 04-23-2014, 12:22 PM

Can I ask a question if this isn't solved yet.

Code:

d = DateSerial(Year(Date), 4, 1) 
w = Weekday(d, vbSunday) 
FirstSunday1 = d + IIf(w, 8 - w, 0) 

d = DateSerial(Year(Date), 10, 1) 
w = Weekday(d, vbSunday) 
FirstSunday2 = d + IIf(w, 8 - w, 0)   

d = DateSerial(Year(DateAdd("yyyy", 1, Date)), 4, 1) 
w = Weekday(d, vbSunday) 
FirstSunday3 = d + IIf(w, 8 - w, 0)

when you use an IIF statement you should be comparing W to something to find out if it's true or not

Code:

d = DateSerial(Year(Date), 4, 1)
w = Weekday(d)
FirstSunday1 = DateAdd("d", (IIf(w = 1, 0, 8 - w)), d)

Second, you do not need, as far as I can tell, the firstsunday3 at all
Third, you have some logical inconsistencies in your case statement right now
fourth, you are not correctly figuring your firstsunday1 and firstsunday2, you are figuring the date but not the 2AM part to check against try this:

Code:

Dim intState As Integer
Dim cdatetime As Date
Dim TimeOffset As Integer
Dim strInterval As String
Dim FirstSunday1 As Date
Dim FirstSunday2 As Date
Dim FirstSunday3 As Date
Dim d As Date
Dim w As Integer

'set default time
'--------------------------------
TimeOffset = 0
strInterval = ""
'***********************
intState = StateID
'intState = 3
'***********************

d = DateSerial(Year(Date), 4, 1)
w = Weekday(d, vbSunday)
FirstSunday1 = DateAdd("h", 2, (DateAdd("d", (IIf(w = 1, 0, 8 - w)), d)))

d = DateSerial(Year(Date), 10, 1)
w = Weekday(d, vbSunday)
FirstSunday2 = DateAdd("h", 2, (DateAdd("d", (IIf(w = 1, 0, 8 - w)), d)))

cdatetime = Now()

Debug.Print "intState = " & intState
Debug.Print "cdatetime = " & cdatetime
Debug.Print "firstsunday1 = " & FirstSunday1
Debug.Print "firstsunday2 = " & FirstSunday2

Select Case intState
Case 3 'Northern Territory
    If cdatetime < firstsunday Or cdatetime > FirstSunday2 Then
        TimeOffset = -90
        strInterval = "n"
        Debug.Print "NORTHERN TERRITORY - NOT IN DAYLIGHT SAVINGS"
    ElseIf cdatetime >= FirstSunday1 And cdatetime <= FirstSunday2 Then
        TimeOffset = -30
        strInterval = "n"
        Debug.Print "NORTHERN TERRITORY - IN DAYLIGHT SAVINGS"
    Else
        Debug.Print "NORTHERN TERRITORY DEAD LAND"
    End If
Case 4 'Queensland
    If cdatetime < firstsunday Or cdatetime > FirstSunday2 Then
        TimeOffset = -1
        strInterval = "h"
        Debug.Print "QUEENSLAND - NOT IN DAYLIGHT SAVINGS"
    ElseIf cdatetime >= FirstSunday1 And cdatetime <= FirstSunday2 Then
        TimeOffset = 0
        strInterval = "n"
        Debug.Print "QUEENSLAND - IN DAYLIGHT SAVINGS"
    End If
Case 5 'South Australia
    If cdatetime < firstsunday Or cdatetime > FirstSunday2 Then
        TimeOffset = -30
        strInterval = "n"
        Debug.Print "SOUTH AUSTRALIA - NOT IN DAYLIGHT SAVINGS"
    ElseIf cdatetime >= FirstSunday1 And cdatetime <= FirstSunday2 Then
        TimeOffset = -30
        strInterval = "n"
        Debug.Print "SOUTH AUSTRALIA - IN DAYLIGHT SAVINGS"
    End If
Case 8 'Western Australia
    If cdatetime < firstsunday Or cdatetime > FirstSunday2 Then
        TimeOffset = -3
        strInterval = "h"
        Debug.Print "WESTERN AUSTRALIA - NOT IN DAYLIGHT SAVINGS"
    ElseIf cdatetime >= FirstSunday1 And cdatetime <= FirstSunday2 Then
        TimeOffset = -2
        strInterval = "h"
        Debug.Print "WESTERN AUSTRALIA - IN DAYLIGHT SAVINGS"
    End If
End Select
    
Debug.Print "TimeOffset = " & TimeOffset
Debug.Print "strInterval = " & strInterval

If strInterval <> "" Then
    Debug.Print "Time Change Applied"
    'Forms!frmSchools!box1.Value = "not applicable"
    cdatetime = DateAdd(strInterval, TimeOffset, cdatetime)
Else
    Debug.Print "No Time Change Applied"
End If
   
Debug.Print cdatetime

**Ruegen** · 04-23-2014, 05:57 PM

I went with:

Code:

Function DaylightSavings(StateID As Integer)


Dim intState As Integer
Dim cdatetime As Date
Dim TimeOffset As Integer
Dim strInterval As String
Dim FirstSunday1 As Date
Dim FirstSunday2 As Date
'Dim FirstSunday3 As Date
Dim d1 As Date
Dim w1 As Integer




   'set default time
'--------------------------------
   TimeOffset = 0
   strInterval = ""
    intState = StateID


d = DateSerial(Year(Date), 4, 1)
w = Weekday(d, vbSunday)
FirstSunday1 = d + IIf(w, 8 - w, 0)


d = DateSerial(Year(Date), 10, 1)
w = Weekday(d, vbSunday)
FirstSunday2 = d + IIf(w, 8 - w, 0)


'd = DateSerial(Year(DateAdd("yyyy", 1, Date)), 4, 1)
'w = Weekday(d, vbSunday)
'FirstSunday3 = d + IIf(w, 8 - w, 0)




'set default time
cdatetime = Date




 If Format(cdatetime, "dd/mm/yyyy;hh:mm:ss") > Format(FirstSunday1, "dd/mm/yyyy;hh:mm:ss") Then




                If Format(cdatetime, "dd/mm/yyyy;hh:mm:ss") > Format(FirstSunday2, "dd/mm/yyyy;hh:mm:ss") Then
                    
                    Select Case intState
                    Case 3 'Northern Territory
                            TimeOffset = -30
                            strInterval = "n"
                            
                    Case 4 'Queensland
                            TimeOffset = 0
                            strInterval = "n"
                
                    Case 5 'South Australia
                            TimeOffset = -30
                            strInterval = "n"
                            
                    Case 8 'Western Australia
                            TimeOffset = -2
                            strInterval = "h"
                
                    End Select


                
                Else
                    
                    Select Case intState
                    Case 3 'Northern Territory
                            TimeOffset = -90
                            strInterval = "n"
                            
                    Case 4 'Queensland
                            TimeOffset = -1
                            strInterval = "h"
                            
                    Case 5 'South Australia
                            TimeOffset = -30
                            strInterval = "n"
                            
                    Case 8 'Western Australia
                            TimeOffset = -3
                            strInterval = "h"
                            
                     End Select


                   
                End If
     
Else
        
        
        
                    Select Case intState
                    Case 3 'Northern Territory
                            TimeOffset = -90
                            strInterval = "n"
                            
                    Case 4 'Queensland
                            TimeOffset = -1
                            strInterval = "h"
                            
                    Case 5 'South Australia
                            TimeOffset = -30
                            strInterval = "n"
                            
                    Case 8 'Western Australia
                            TimeOffset = -3
                            strInterval = "h"
                
                    End Select
                
                     
End If




  If strInterval <> "" Then


     cdatetime = DateAdd(strInterval, TimeOffset, Now())
      Else
      cdatetime = Now()


   End If
   
   DaylightSavings = cdatetime


End Function

Although repeare's version looks a lot neater.

Not sure about using

d = DateSerial(Year(Date), 4, 1)
w = Weekday(d)
FirstSunday1 = DateAdd("d", (IIf(w = 1, 0, 8 - w)), d)

but will look into that.

**Ruegen** · 04-23-2014, 06:03 PM

The biggest problem I find is dates being in the wrong order - because VBA uses American date format it screws with everything so I have to make sure it is formatted each time a date is called.

Find First Sunday of month chosen function

Thread Tools

Similar Threads

Use DLookup to autofill values in fields, based on value chosen by Select function

To find Month and Days in given date period

How do I create a search function that then takes you to the chosen record?

Find a month for each Name.

Find # of Sundays in a month

Posting Permissions