Here is a piece a code I borrowed, you enter the date and how many days you want to go back and it will go back to that date excluding weekends and holidays.
Function GetBusinessDay(ByVal StartDate As Variant, ByVal NumDays As Integer) As Date
On Error GoTo MyError
'Date1 is the starting date and NumDays is the
'number of Business Days you want to add
'ie, GetBusinessDays(#3/1/01#,1) would return #3/2/01# (weekday with no holiday)
If IsDate(StartDate) = False Then
GetBusinessDay = Null
Exit Function
End If
If NumDays = 0 Then
GetBusinessDay = StartDate
Exit Function
End If
Dim date1 As Date
Dim date2 As Date
Dim i As Variant
Dim iDaysSub As Integer
date1 = CDate(dateValue(StartDate))
iDaysSub = NumDays
Do Until iDaysSub = 0
If OfficeClosed(date1) = False Then
iDaysSub = iDaysSub - 1
date1 = date1 - 1
Else
date1 = date1 - 1
End If
Loop
GetBusinessDay = date1
GetBusinessDay_Exit:
Exit Function
MyError:
MsgBox Err.Description & " - " & Err.Number
Resume GetBusinessDay_Exit
End Function
Function OfficeClosed(InDate) As Integer
OfficeClosed = False
' Test for Saturday or Sunday.
If WeekDay(InDate) = 1 Or WeekDay(InDate) = 7 Then
OfficeClosed = True
' Test for Holiday.
ElseIf Not IsNull(DLookup("HoliDate", "Holidays", "[HoliDate]=#" _
& InDate & "#")) Then
OfficeClosed = True
End If
End Function
Function AddBusinessDays(ByVal StartDate As Variant, ByVal NumDays As Integer) As Date
On Error GoTo MyError
'Date1 is the starting date and NumDays is the
'number of Business Days you want to add
'ie, GetBusinessDays(#3/1/01#,1) would return #3/2/01# (weekday with no holiday)
If IsDate(StartDate) = False Then
AddBusinessDays = Null
Exit Function
End If
If NumDays = 0 Then
AddBusinessDays = StartDate
Exit Function
End If
Dim date1 As Date
Dim date2 As Date
Dim i As Integer
Dim iDaysAdded As Integer
date1 = CDate(dateValue(StartDate))
i = 0
Do While NumDays <> iDaysAdded
i = i + 1
date2 = DateAdd("d", i, date1)
If LCase(Format(date2, "dddd")) <> "saturday" And LCase(Format(date2, "dddd")) <> "sunday" Then
Select Case CStr(Format(date2, "mmdd"))
Case "0101", "0704", "1225"
Case Else
Select Case date2
Case #11/22/2001#, #11/21/2002#, #11/20/2003#, #11/25/2004#, #11/24/2005#, #11/23/2006#, #11/22/2007#, #11/20/2008#, #11/26/2009#, #11/25/2010#, #11/24/2011#, #11/22/2012#, #11/21/2013#, #11/20/2014#, #11/26/2015#
Case Else
Debug.Print date2
iDaysAdded = iDaysAdded + 1
End Select
End Select
End If
Loop
AddBusinessDays = DateAdd("d", i, date1)
AddBusinessDays_Exit:
Exit Function
MyError:
MsgBox Err.Description & " - " & Err.Number
Resume AddBusinessDays_Exit
End Function
Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)
On Error GoTo ReportError
Dim y As String
Dim MyDate As Date
'Check to see if approval date has a value if not exit else call check business days.
If IsNull(Me.AAPRVD) Then
Exit Sub
Else
getLocalDate1 (AAPRVD)
End If
Report_Exit:
Exit Sub
ReportError:
MsgBox Err.Description & " - " & Err.Number
Resume Report_Exit
End Sub
Private Sub Report_Open(Cancel As Integer)
gDate5 = GetBusinessDay(Now(), 5)
gDate10 = GetBusinessDay(Now(), 10)
gDate20 = GetBusinessDay(Now(), 20)
End Sub
Function getLocalDate1(AAPRVD As Variant) As Variant
Dim y As String
Dim MyDate As Date
If AAPRVD > 0 Then
getLocalDate1 = Num2Date(AAPRVD, "YYMMDD")
Else
getLocalDate1 = Null
End If
Me.chk1 = False
Me.chk2 = False
Me.chk3 = False
If getLocalDate1 < gDate5 Then
'If DateDiff("d", gDate, getLocalDate1) >= 5 Then
Me.chk1 = True
End If
If getLocalDate1 < gDate10 Then
'If DateDiff("d", gDate, getLocalDate1) >= 10 Then
Me.chk2 = True
End If
If getLocalDate1 < gDate20 Then
'If DateDiff("d", gDate, getLocalDate1) >= 20 Then
Me.chk3 = True
End If
End Function
