A little Module for everyone to help with ALL TYPES OF date functions 9

[zishan619]

Hi everyone:
This is a module that would help you out with any type of date functions:Just copy and paste it into a module.
Option Compare Database
'A Little book of Month, Days, Coding

Function Convdt(ByVal dtsDate As Variant) As Variant
If Not IsDate(dtsDate) Then
Convdt = Null
Else
Convdt = CDate(dtsDate)
End If
End Function

Function EndOfMonth(xdate As Variant)
On Error Resume Next
If IsNull(xdate) Then
EndOfMonth = Null
Else
EndOfMonth = DateAdd("d", -1, DateAdd("m", 1, StartOfMonth(xdate)))
End If
End Function

Function GetBeginDateofQuarter(xdate As Variant) As Variant
'this function takes any date and returns the first day of that quarter
If IsNull(xdate) Then
GetBeginDateofQuarter = Null
Exit Function
End If
Dim tval As Variant
tval = DatePart("q", xdate)
tval = (tval * 3) - 2
tval = DateValue(tval & "/1/" & Year(xdate))
GetBeginDateofQuarter = tval
End Function

Function GetEndDateofQuarter(xdate As Variant) As Variant
'this function takes any date and returns the last day of the last month of that quarter
If IsNull(xdate) Then
GetEndDateofQuarter = Null
Exit Function
End If
Dim tval As Variant
tval = DatePart("q", xdate)
tval = (tval * 3)
tval = DateValue(tval & "/1/" & Year(xdate))
tval = EndOfMonth(tval)
GetEndDateofQuarter = tval

End Function

Function GetFirstDayLastMonthofQuarter(xdate As Variant) As Variant
'this function takes any date and returns the first day of the last month of that quarter
If IsNull(xdate) Then
GetFirstDayLastMonthofQuarter = Null
Exit Function
End If
Dim tval As Variant
tval = DatePart("q", xdate)
tval = (tval * 3)
tval = DateValue(tval & "/1/" & Year(xdate))
GetFirstDayLastMonthofQuarter = tval

End Function

Function GetLastQuartersQtrNum()
Dim tval As Variant
tval = Date
tval = DateAdd("q", -1, tval)
tval = DatePart("q", tval)
GetLastQuartersQtrNum = tval

End Function

Function GetLastQuartersYear()
Dim tval As Variant
tval = Date
tval = DateAdd("q", -1, tval)
tval = DatePart("yyyy", tval)
GetLastQuartersYear = tval
End Function

Function GetPrevDay(xdate As Variant) As Variant
GetPrevDay = DateAdd("y", -1, xdate)

End Function

Function StartOfMonth(xdate As Variant) As Variant
On Error Resume Next
If IsNull(xdate) Then
StartOfMonth = Null
Else
StartOfMonth = DateValue(Month(xdate) & "/1/" & Year(xdate))
End If
End Function

Function StartofNextMonth(xdate As Variant) As Variant
On Error Resume Next
Dim tdate As Variant
tdate = DateAdd("m", 1, xdate)
StartofNextMonth = DateValue(Month(tdate) & "/1/" & Year(tdate))
End Function

Function PreviousMonth(xdate As Variant) As Variant
On Error Resume Next
Dim tdate As Variant
If IsNull(xdate) Then
PreviousMonth = Null
Else
tdate = DateAdd("m", -1, xdate)
PreviousMonth = DateValue(Month(tdate) & "/1/" & Year(tdate))
End If
End Function
Function LMTD(xdate As Variant) As Variant
On Error Resume Next
If IsNull(xdate) Then
LMTD = Null
Else
tdate = DateAdd("m", -1, DateAdd("d", -1, xdate))
LMTD = DateValue(tdate)
End If
End Function

Public Function GetDays(ByVal dtsDate As Variant, ByVal lngday As Long) As Long
'sample call GetDays(Date(),4) returns number of Wednesdays in current month
'1 = sunday, 2 = monday, 3 = tues, 4 = wed, 5 = thrs, 6 = fri, 7 = sat
Dim dtsStart As Date
Dim dtsEnd As Date
Dim lngCount As Long
lngCount = 0
dtsStart = StartOfMonth(dtsDate)
dtsEnd = EndOfMonth(dtsDate)
Dim MyDate As Variant
MyDate = dtsStart
Do Until MyDate > dtsEnd
If WeekDay(MyDate) = lngday Then
lngCount = lngCount + 1
End If
MyDate = MyDate + 1
Loop
GetDays = lngCount
End Function

Public Function PastDays(ByVal dtsDate As Variant, ByVal lngday As Long) As Long
'sample call PastDays(Date(),4) returns number of Wednesdays in current month
'1 = sunday, 2 = monday, 3 = tues, 4 = wed, 5 = thrs, 6 = fri, 7 = sat
Dim dtsStart As Date
Dim dtsEnd As Date
Dim lngCount As Long
lngCount = 0
dtsStart = StartOfMonth(dtsDate)
dtsEnd = [Forms]![frmReportControl]![EndDate]
Dim MyDate As Variant
MyDate = dtsStart
Do Until MyDate > dtsEnd
If WeekDay(MyDate) = lngday Then
lngCount = lngCount + 1
End If
MyDate = MyDate + 1
Loop
PastDays = lngCount
End Function

Public Function H(ByVal dtsDate As Variant, ByVal lngday As Long) As Long
'sample call GetDays(Date(),4) returns number of Wednesdays in current month
'1 = sunday, 2 = monday, 3 = tues, 4 = wed, 5 = thrs, 6 = fri, 7 = sat
Dim dtsStart As Date
Dim dtsEnd As Date
Dim lngCount As Long
lngCount = 0
dtsStart = StartOfMonth(dtsDate)
dtsEnd = EndOfMonth(dtsDate)
Dim MyDate As Variant
MyDate = dtsStart
Do Until MyDate > dtsEnd
If WeekDay(MyDate) = lngday Then
If Not IsHoliday(MyDate) Then
lngCount = lngCount + 1
Else
'Do nothing, it's a holiday
End If
End If
MyDate = MyDate + 1
Loop
H = lngCount
End Function
Public Function Days(Optional dtsDate As Date = 0) As Integer
If dtsDate = 0 Then
dtsDate = Date
End If
Days = DateSerial(Year(dtsDate), Month(dtsDate) + 1, 1) - DateSerial(Year(dtsDate), Month(dtsDate), 1)
End Function
Public Function WholeMonth(ByVal dtsDate As Variant) As Variant

Dim dtsEnd As Date
Dim MyDate As Variant
dtsEnd = EndOfMonth(dtsDate)
MyDate = dtsDate
Do
Do Until MyDate > dtsEnd
MyDate = MyDate + 1
If MyDate < dtsEnd Then
WholeMonth = DateAdd(&quot;d&quot;, 1, MyDate)
Exit Do
End If
Loop
Debug.Print WholeMonth
Loop Until MyDate > dtsEnd
End Function

Public Function CompleteH(ByVal dtsDate As Variant, ByVal lngday As Long) As Long
'Gives you how many completed during the month minus holidays
'1 = sunday, 2 = monday, 3 = tues, 4 = wed, 5 = thrs, 6 = fri, 7 = sat
Dim dtsStart As Date
Dim dtsEnd As Date
Dim lngCount As Long
lngCount = 0
dtsStart = StartOfMonth(dtsDate)
dtsEnd = [Forms]![frmReportControl]![EndDate]
Dim MyDate As Variant
MyDate = dtsStart
Do Until MyDate > dtsEnd
If WeekDay(MyDate) = lngday Then
If Not IsHoliday(MyDate) Then
lngCount = lngCount + 1
Else
'Do nothing, it's a holiday
End If
End If
MyDate = MyDate + 1
Loop
CompleteH = lngCount
End Function

Function PrevMonth(xdate As Variant) As Variant
On Error Resume Next
Dim tdate As Variant
If IsNull(xdate) Then
PrevMonth = Null
Else
tdate = DateAdd(&quot;m&quot;, -1, xdate)
PrevMonth = Format(tdate, &quot;mmm yyyy&quot

End If
End Function
Cool. Thanks

 

[Genimuse]

Very nice indeed! Worth more than the one star I gave!

I have a few of questions:

What do LMTD(), Days(), and H() do?

What does PastDays() do? It's description is nearly identical to GetDays().

What does H() do? It's description is identical to GetDays().

 

[EBee]

How can I use some of these code to look at a date table for financial calendar that we follow. Our period 1 (periods 1-12) starts at Dec 30. and ends on Feb 2. this conforms to the even weeks for each month.

-thanks

 

[zishan619]

LMTD= Last Month to Date
LMTD(Date()) will bring 06/30/03.
Getdays(Date(),1)
This will give you how many Sundays(1) are in this Month.
There is another functionfor the use of Holidays. That is where IsHolidays comes into play.
Public Function IsHoliday(ByVal dtsDate As Variant)
Dim rs As Recordset
Dim StrSQL As String
Dim db As Database

StrSQL = &quot;SELECT Date FROM tblHolidays WHERE Date= # &quot; & dtsDate & &quot;#&quot;
Set rs = CurrentDb.OpenRecordset(StrSQL, dbOpenSnapshot)
If rs.EOF And rs.BOF Then
IsHoliday = False
Else
IsHoliday = True
End If


End Function
This table will contain All the holidays that are needed for the business area.
You can use this function in your CompletedH function or H function.
If you have any questions let me know. Thanks

 

[judgehopkins]

A good dates reference:

http://www.developershandbook.com/downloads/2162ch03.pdf

Judge Hopkins

http://www.psc.state.mo.us/adjudication.asp

There are only two rules for success: (1) Never tell everything you know.

 

[kh5455]

Hi,
zishan619


How can I use some of these code gave me examples please


thank you

 

[judgehopkins]

zishan619, there are samples galore in the *.pdf link above.

Judge Hopkins

http://www.psc.state.mo.us/adjudication.asp

There are only two rules for success: (1) Never tell everything you know.

 

[zishan619]

Sure Kh544:
Examples:
StartofMonth(Date()) = 06/01/03
EndofMonth(Date()) = 06/30/03
You can do a Between statement in queries by saying
Between StartofMonth(date()) And EndofMonth(Date())
Between 06/01/03 And 06/30/03
or
Between PreviousMonth(Date()) And PrevEndMonth(Date())
Between 05/1/03 And 05/31/03
or
Between PreviousMonth(Date()) And LMTD(Date())
Between 05/1/03 And 05/10/03
LMTD(Date()) = 05/10/03

Getdays(Date(),1) 1 being sunday ...there are 5 Sundays in June 2003
or
Getdays(PreviousMonth(Date()),1) there were 4 Sundays Last Month in May 2003
Cool I hope this helps
Thanks
Zishan

 

[JeremyNYC]

Well, you're maxed out on stars, but I can still say thanks for the code.

Thanks.

Jeremy

PS: You don't have option explicit in there, and one of your variables isn't declared. Also, you didn't include the IsHoliday function in there, so I had to comment that out.

PPS: This takes nothing off the thanks--that stuff is easy enough to put in there myself.

==
Jeremy Wallace
AlphaBet City Dataworks

http://www.ABCDataworks.com

Affordable Development, Professionally Done

Please post in the appropriate forum with a descriptive subject; code and SQL, if referenced; and expected results. See thread181-473997 for more pointers.

 

[kh5455]

Hi,
zishan619

Iam still Biganner with access

would you tell me how I can use those Functions with The Form ???? Gave me Example Pleasssse .

thanks alot,,,,,

 

[zishan619]

HI kh5455
I gave examples up above. Check it out.

 

[bikebanditcom]

kh5455,

To use these functions, you can build an expression using them and the fields in your form or table. These can be used in querys or in form functions. To call them, for instance, in a query, right click where the expression would go, and click build, and on the left hand side of the dialog box you'll see down the list functions, and the new functions you added will be listed under functions, then the database name. good luck, i'm a beginner too thats how i understood what you meant.

dan

 

[smurf01]

zishan619
Have a star, well worth it

Regards

Paul

 

[SBendBuckeye]

Excellent, thanks for sharing and have a star! A couple little gotchas to avoid later problems and which detract absolutely nothing from your work:

1. Always reset error handling

2. Always check for IsDate if variant argument

3. Add a check for Int(xDate) = 0 because a time value will pass the IsDate check and be converted to some old odd ball date

Thanks again!