Find the Last Working Day Of Next Month

Category:

Dates and Math

Type:

Snippets

Difficulty:

Beginning

Author:

Keith Ollerton

Version Compatibility: Visual Basic 6, Visual Basic 5

More information:

This function returns the last working day of the next month(Monday - Friday ignoring holidays) for a given date:

It consists of two functions - the IsLeapYear function is a direct copy of that by Brian Gillham (at http://acs.nv.net/freevbcode/ShowCode.Asp?ID=391).

The function could be easily changed to show last working date of the current month or any number of months following.

Instructions: Copy the declarations and code below and paste directly into your VB project.

Declarations:
' (None)

Code:

Public Function LastWorkDayOfNextMonth(StartDate As String) _
   As String

If Not IsDate(StartDate) Then Exit Function

Dim DateToView As Date
Dim MonthToView As Integer
Dim YearToView As Integer
Dim Days As Integer
Dim CheckDay As Integer

DateToView = StartDate
MonthToView = Month(DateToView) + 1
YearToView = Year(DateToView)
If MonthToView = 13 Then
    MonthToView = 1
    YearToView = YearToView + 1
End If
Select Case MonthToView
Case 1
Days = 31
Case 2
If IsLeapYear("01/02/" & YearToView) Then
Days = 29
Else
Days = 28
End If
Case 3
Days = 31
Case 4
Days = 30
Case 5
Days = 31
Case 6
Days = 30
Case 7
Days = 31
Case 8
Days = 31
Case 9
Days = 30
Case 10
Days = 31
Case 11
Days = 30
Case 12
Days = 31
End Select

For CheckDay = 1 To Days

If Weekday(CheckDay & "/" & MonthToView & "/" & _
  YearToView) <> 7 And Weekday(CheckDay & "/" & MonthToView _
  & "/" & YearToView) <> 8 Then

' This is a not a Saturday or Sunday so choose it (unless 
'we find another elsewhere in the loop)
LastWorkDayOfNextMonth = CheckDay & "/" & MonthToView & "/" & _
   YearToView
End If

Next CheckDay
'use of cdate ensures compatibility
'with regional date settings
LastWorkDayOfNextMonth = CStr(CDate(LastWorkDayOfNextMonth))
'MsgBox LastWorkDayOfNextMonth
End Function

Function IsLeapYear(ByVal SomeValue As Variant) As Boolean

On Error GoTo LocalError
Dim intYear As Integer
'The trick here is make sure that we get an integer
'The 3 Golden rules are:
'True if it is divisible by 4
'False if it is divisible by 100
'TRUE if it is divisble by 400
If IsDate(SomeValue) Then
intYear = CInt(Year(SomeValue))
Else
'try and get an integer from the parse
'does not matter if we get an error
'because the error trap will catch it
intYear = CInt(SomeValue)
End If
If TypeName(intYear) = "Integer" Then
IsLeapYear = ((intYear Mod 4 = 0) And _
(intYear Mod 100 <> 0) Or (intYear Mod 400 = 0))
End If
Exit Function
LocalError:
IsLeapYear = False

End Function