Date Calculations in VBA
I have picked up a number of date function from the web over the years and added some changes for my own use. These pick be useful for your projects
'---------------------------------------------------------------------- ' FUNCTION: BeginLastMonth ' PURPOSE : Returns the last calendar day of last month '---------------------------------------------------------------------- Function BeginLastMonth() BeginLastMonth = DateAdd("m", -1, DateSerial(Year(Date), Month(Date), 1)) End Function '---------------------------------------------------------------------- ' FUNCTION: BeginNextMonth ' PURPOSE : Returns the first day of next month '---------------------------------------------------------------------- Function BeginNextMonth() BeginNextMonth = DateAdd("m", 1, DateSerial(Year(Date), Month(Date), 1)) End Function '---------------------------------------------------------------------- ' FUNCTION: BeginThisMonth ' PURPOSE : Returns the first day of the current month. '---------------------------------------------------------------------- Function BeginThisMonth() BeginThisMonth = DateSerial(Year(Date), Month(Date), 1) End Function '---------------------------------------------------------------------- ' FUNCTION: EndofMonth ' PURPOSE : Returns the date of the last day of a month/year combination. '---------------------------------------------------------------------- Function EndofMonth(Vdate) As Variant If IsNull(Vdate) Then Exit Function EndofMonth = DateAdd("M", 1, DateSerial(Year(Vdate), Month(Vdate), 1)) - 1 End Function Function EndofThisMonth() EndofThisMonth = DateAdd("m", 1, DateSerial(Year(Date), Month(Date), 1)) - 1 End Function Function EndOfWeek(D As Variant, Optional FirstWeekday As Integer) As Variant ' ' Returns the date representing the last day of the current week. ' ' Arguments: ' D = Date ' FirstWeekday = (Optional argument) Integer that represents the first ' day of the week (e.g., 1=Sun..7=Sat). ' If IsMissing(FirstWeekday) Then 'Sunday is the assumed first day of week. EndOfWeek = D - WeekDay(D) + 7 Else EndOfWeek = D - WeekDay(D, FirstWeekday) + 7 End If End Function Function StartOfWeek(D As Variant, Optional FirstWeekday As Integer) As Variant ' ' Returns the date representing the last day of the current week. ' ' Arguments: ' D = Date ' FirstWeekday = (Optional argument) Integer that represents the first ' day of the week (e.g., 1=Sun..7=Sat). ' If IsMissing(FirstWeekday) Then 'Sunday is the assumed first day of week. StartOfWeek = D + WeekDay(D) - 7 Else StartOfWeek = D + WeekDay(D, FirstWeekday) - 7 End If End Function Function ElapsedDays(StartDate As Date, EndDate As Date) As Long ElapsedDays = Int(CSng(EndDate - StartDate)) End Function Function DayName(tmpDay As Integer) Select Case tmpDay Case 1 DayName = "Sunday" Case 2 DayName = "Monday" Case 3 DayName = "Tuesday" Case 4 DayName = "Wednesday" Case 5 DayName = "Thursday" Case 6 DayName = "Friday" Case 7 DayName = "Saturday" End Select End Function Function Daynam(tmpDate As Date, Optional tmpS As Boolean) Dim Day, Dat tmpFirstDay = GetPref("First Day of Week") If IsNull(tmpFirstDay) Then tmpFirstDay = GetPref("First Day of Week") End If Select Case tmpFirstDay Case 0 ' Sunday Day = Array("Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday") Case 1 ' Sunday Day = Array("Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday") Case 2 ' Monday Day = Array("Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", "Sunday") Case 3 ' Tuesday Day = Array("Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", "Sunday", "Monday") Case 4 ' Wednesday Day = Array("Wednesday", "Thursday", "Friday", "Saturday", "Sunday", "Monday", "Tuesday") Case 5 ' Thursday Day = Array("Thursday", "Friday", "Saturday", "Sunday", "Monday", "Tuesday", "Wednesday") Case 6 ' Friday Day = Array("Friday", "Saturday", "Sunday", "Monday", "Tuesday", "Wednesday", "Thursday") Case 7 ' Saturday Day = Array("Saturday", "Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday") End Select If tmpS Then Daynam = Left(Day(WeekDay(tmpDate)), 3) Else Daynam = Day(WeekDay(tmpDate)) End If End Function Function getFday() If IsNull(tmpFirstDay) Or IsEmpty(tmpFirstDay) Then tmpFirstDay = GetPref("First Day of Week") End If getFday = Val(tmpFirstDay) End Function
This link is also useful for ISOWeeknum and ISOYWD2Date
see this link http://www.cpearson.com/excel/DateTimeVBA.htm