I have the following expression in a query:

CDate:dhSubtractWorkDaysA([LTW1],[MatDueDateCalc],[HolidayArray])

I've posted the module below that contains functions that subtract # of days
in [LTW1] from the date in [MatDueDateCalc], without counting Saturdays,
Sundays or holidays.  I have a table called Holiday with one field called
HolidayDates.  Currently, when my query runs, a parameter box appears where I
can either type a holiday date or click OK to not include any holidays.  I'm
not sure how to make my HolidaysDate table an array so that when I run this
query, it will look at the list of dates in my HolidayDate table and not
subtract a date if it is in the HolidayDate table.  Can anyone please tell me
how to do this.  I'm a very basic VBA user and I'm sort of at a loss.

Thank you so much -

Function Code:

Option Compare Database

Public Function dhSubtractWorkDaysA(lngDays As Long, _
Optional dtmDate As Date = 0, _
Optional adtmDates As Variant) As Date
   Dim lngCount As Long
   Dim dtmTemp As Date
   
       
   If dtmDate = 0 Then
       dtmDate = Date
   End If
   
   dtmTemp = dtmDate
   For lngCount = 1 To lngDays
       dtmTemp = dhPreviousWorkdayA(dtmTemp, adtmDates)
   Next lngCount
   dhSubtractWorkDaysA = dtmTemp
End Function

Public Function dhNextWorkdayA( _
Optional dtmDate As Date = 0, _
Optional adtmDates As Variant = Empty) As Date
If dtmDate = 0 Then
       dtmDate = Date
   End If
   
   dhNextWorkdayA = SkipHolidaysA(adtmDates, dtmDate + 1, 1)
End Function
Public Function dhPreviousWorkdayA( _
Optional dtmDate As Date = 0, _
Optional adtmDates As Variant = Empty) As Date
   If dtmDate = 0 Then
       dtmDate = Date
   End If
   
   dhPreviousWorkdayA = SkipHolidaysA(adtmDates, dtmDate - 1, -1)
End Function

Public Function dhFirstWorkdayInMonthA( _
Optional dtmDate As Date = 0, _
Optional adtmDates As Variant = Empty) As Date
Dim dtmTemp As Date
   
   
   If dtmDate = 0 Then
       dtmDate = Date
   End If
   
   dtmTemp = DateSerial(Year(dtmDate), Month(dtmDate), 1)
   dhFirstWorkdayInMonthA = SkipHolidaysA(adtmDates, dtmTemp, 1)
End Function

Public Function dhLastWorkdayInMonthA( _
Optional dtmDate As Date = 0, _
Optional adtmDates As Variant = Empty) As Date
   Dim dtmTemp As Date
   
   
   If dtmDate = 0 Then
       dtmDate = Date
   End If
   
   dtmTemp = DateSerial(Year(dtmDate), Month(dtmDate) + 1, 0)
   dhLastWorkdayInMonthA = SkipHolidaysA(adtmDates, dtmTemp, -1)
End Function

Public Function dhCountWorkdaysA(ByVal dtmStart As Date, ByVal dtmEnd As
Date, _
Optional adtmDates As Variant = Empty) _
As Integer

   Dim intDays As Integer
   Dim dtmTemp As Date
   Dim intSubtract As Integer
   
   
   If dtmEnd < dtmStart Then
       dtmTemp = dtmStart
       dtmStart = dtmEnd
       dtmEnd = dtmTemp
   End If
   
   
   dtmStart = SkipHolidaysA(adtmDates, dtmStart, 1)
   dtmEnd = SkipHolidaysA(adtmDates, dtmEnd, -1)
   If dtmStart > dtmEnd Then
       
       dhCountWorkdaysA = 0
   Else
       intDays = dtmEnd - dtmStart + 1
       
       intSubtract = (DateDiff("ww", dtmStart, dtmEnd) * 2)
       
       intSubtract = intSubtract + _
        CountHolidaysA(adtmDates, dtmStart, dtmEnd)
       
       dhCountWorkdaysA = intDays - intSubtract
   End If
End Function

Private Function CountHolidaysA( _
adtmDates As Variant, _
dtmStart As Date, dtmEnd As Date) As Long

   Dim lngItem As Long
   Dim lngCount As Long
   Dim blnFound As Long
   Dim dtmTemp As Date
   
   On Error GoTo HandleErr
   lngCount = 0
   Select Case VarType(adtmDates)
       Case vbArray + vbDate, vbArray + vbVariant
           
           For lngItem = LBound(adtmDates) To UBound(adtmDates)
               dtmTemp = adtmDates(lngItem)
               If dtmTemp >= dtmStart And dtmTemp <= dtmEnd Then
                   If Not IsWeekend(dtmTemp) Then
                       lngCount = lngCount + 1
                   End If
               End If
           Next lngItem
       Case vbDate
           
           If adtmDates >= dtmStart And adtmDates <= dtmEnd Then
               If Not IsWeekend(adtmDates) Then
                   lngCount = 1
               End If
           End If
   End Select

ExitHere:
   CountHolidaysA = lngCount
   Exit Function
   
HandleErr:
   
   Resume ExitHere
End Function
Private Function FindItemInArray(varItemToFind As Variant, _
avarItemsToSearch As Variant) As Boolean
   Dim lngItem As Long
   
   On Error GoTo HandleErrors
   
   For lngItem = LBound(avarItemsToSearch) To UBound(avarItemsToSearch)
       If avarItemsToSearch(lngItem) = varItemToFind Then
           FindItemInArray = True
           GoTo ExitHere
       End If
   Next lngItem
   
ExitHere:
   Exit Function
   
HandleErrors:
 
   Resume ExitHere
End Function
Private Function IsWeekend(dtmTemp As Variant) As Boolean
If VarType(dtmTemp) = vbDate Then
       Select Case Weekday(dtmTemp)
           Case vbSaturday, vbSunday
               IsWeekend = True
           Case Else
               IsWeekend = False
       End Select
   End If
End Function
Private Function SkipHolidaysA( _
adtmDates As Variant, _
dtmTemp As Date, intIncrement As Integer) As Date
   Dim strCriteria As String
   Dim strFieldName As String
   Dim lngItem As Long
   Dim blnFound As Boolean
   
   On Error GoTo HandleErrors
   
   
   Do
       Do While IsWeekend(dtmTemp)
       ' Missy
           dtmTemp = dtmTemp + intIncrement
       Loop
       Select Case VarType(adtmDates)
           Case vbArray + vbDate, vbArray + vbVariant
               Do
                   blnFound = FindItemInArray(dtmTemp, adtmDates)
                   If blnFound Then
                       dtmTemp = dtmTemp + intIncrement
                   End If
               Loop Until Not blnFound
           Case vbDate
               If dtmTemp = adtmDates Then
                   dtmTemp = dtmTemp + intIncrement
               End If
       End Select
   Loop Until Not IsWeekend(dtmTemp)
   
ExitHere:
   SkipHolidaysA = dtmTemp
   Exit Function
   
HandleErrors:
   
   Resume ExitHere
End Function

"MGFoster" wrote:

Expand AllCollapse All