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

1 reply

Leave a Reply

Want to join the discussion?
Feel free to contribute!

Leave a Reply