by Anonymous (267 Submissions)
Category: Miscellaneous
Compatability: Visual Basic 4.0 (32-bit)
Difficulty: Unknown Difficulty
Originally Published: Fri 2nd July 1999
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Various date functions including age calculation, number of days in month, leap year, etc.
VBcoders
'Age Age in years.
'DaysInMonth The number of days in the current month.
'DaysInMonth2 Alternate method.
'EndOfMonth Returns the date for the last day of the current month.
'EndOfWeek Returns the date for the last day in the current week.
'LastBusDay Returns the date for the last business day (Mon-Fri)
' in the current month.
'LeapYear Returns True or False if the year is a leap year.
'LeapYear2 Alternate method.
'NextDay Returns the date for the next day (Sun...Sat) after the
' current date.
'NextDay1 Returns the date for the next day (Sun...Sat) on or
' after the current date.
'PriorDay Returns the date for the last day (Sun...Sat) before
' the current date.
'PriorDay1 Returns the date for the last day (Sun...Sat) on or
' before the current date.
'StartOfMonth Returns the date for the first day of the current
' month.
'StartOfWeek Returns the date for the first day of the current week.
Function Age(ByVal Bdate As Date, ByVal DateToday As Date) As Long
' Doesn't handle negative date ranges i.e. Bdate > DateToday.
If Month(DateToday) < Month(Bdate) _
Or (Month(DateToday) = Month(Bdate) _
And Day(DateToday) < Day(Bdate)) Then
Age = Year(DateToday) - Year(Bdate) - 1
Else
Age = Year(DateToday) - Year(Bdate)
End If
End Function
Function DaysInMonth(ByVal D As Date) As Long
' Requires a date argument because February can change
' if it's a leap year.
Select Case Month(D)
Case 2
If LeapYear(Year(D)) Then
DaysInMonth = 29
Else
DaysInMonth = 28
End If
Case 4, 6, 9, 11
DaysInMonth = 30
Case 1, 3, 5, 7, 8, 10, 12
DaysInMonth = 31
End Select
End Function
Function DaysInMonth2(ByVal D As Date) As Long
' Requires a date argument because February can change
' if it's a leap year.
DaysInMonth2 = Day(DateSerial(Year(D), Month(D) + 1, 0))
End Function
Function EndOfMonth(ByVal D As Date) As Date
EndOfMonth = DateSerial(Year(D), Month(D) + 1, 0)
End Function
Function EndOfWeek(ByVal D As Date) As Date
EndOfWeek = D - Weekday(D) + 7
End Function
Function LastBusDay(ByVal D As Date) As Date
Dim D2 As Variant
D2 = DateSerial(Year(D), Month(D) + 1, 0)
Do While Weekday(D2) = 1 Or Weekday(D2) = 7
D2 = D2 - 1
Loop
LastBusDay = D2
End Function
Function LeapYear(ByVal YYYY As Long) As Boolean
LeapYear = YYYY Mod 4 = 0 _
And (YYYY Mod 100 <> 0 Or YYYY Mod 400 = 0)
End Function
Function LeapYear2(ByVal YYYY As Long) As Boolean
LeapYear2 = Month(DateSerial(YYYY, 2, 29)) = 2
End Function
Function NextDay(ByVal D As Date, ByVal DayCode As Long) As Date
' DayCode (1=Sun ... 7=Sat) or use vbSunday...vbSaturday.
NextDay = D - Weekday(D) + DayCode + _
IIf(Weekday(D) < DayCode, 0, 7)
End Function
Function NextDay1(ByVal D As Date, ByVal DayCode As Long) As Date
NextDay1 = D - Weekday(D) + DayCode + _
IIf(Weekday(D) <= DayCode, 0, 7)
End Function
Function PriorDay(ByVal D As Date, ByVal DayCode As Long) As Date
PriorDay = D - Weekday(D) + DayCode - _
IIf(Weekday(D) > DayCode, 0, 7)
End Function
Function PriorDay1(ByVal D As Date, ByVal DayCode As Long) As Date
PriorDay1 = D - Weekday(D) + DayCode - _
IIf(Weekday(D) >= DayCode, 0, 7)
End Function
Function StartOfMonth(ByVal D As Date) As Date
StartOfMonth = DateSerial(Year(D), Month(D), 1)
End Function
Function StartOfWeek(ByVal D As Date) As Date
StartOfWeek = D - Weekday(D) + 1
End Function
No comments have been posted about Various date functions including age calculation, number of days in month, leap year, etc.. Why not be the first to post a comment about Various date functions including age calculation, number of days in month, leap year, etc..
