Thanks so much for your help. I changed all of my expressions to use Switch,
which really cleaned them up.
I'm not sure how to change by function to return zero. I am a very basic VBA
user. I've posted my code here in hopes that you can help me.
Also, I'm trying to make my Holiday table that contains one field called
HolidayDates an array so I can use it as adtmDates in these functions. Can
you help me?
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 said:
Alex said:
I have the following query. I'm trying to avoid getting #error messages in
some of the fields that should return as null. How can I rewrite this query
correctly?
Thanks so much
MCSOne:
IIf(nz([M_B]="A",dhSubtractWorkDaysA([LTA2],[SystemDoc],[HolidayArray]),IIf([M_B]="W",dhSubtractWorkDaysA([LTW3],[SystemDoc],[HolidayArray]),IIf([M_B]="P"
Or [M_B]="T",dhSubtractWorkDaysA([LTTP2],[POIssueDate],[HolidayArray]))),"")))
-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1
It looks like the function "dhSubtractWorkDaysA" is returning a NULL.
Change it so it will return zero, instead. Also, change it so when it
receives a NULL parameter it returns zero, 'cuz it can't calculate the
work days if it doesn't have both dates.
To simplify the above expression you could change the call parameters
like this (I spread it out so you can see it better. It is really one
line.):
dhSubtractWorkDaysA(
Switch(
[M_B]="A", [LTA2],
[M_B]="W", [LTW3],
[M_B] IN ("P","T"), [LLTP2]
),
IIf([M_B] NOT IN ("P","T"), [SystemDoc],[POIssueDate])
[HolidayArray]
)
--
MGFoster:::mgf00 <at> earthlink <decimal-point> net
Oakland, CA (USA)
-----BEGIN PGP SIGNATURE-----
Version: PGP for Personal Privacy 5.0
Charset: noconv
iQA/AwUBQjIM2YechKqOuFEgEQISZgCcD/BL4Bz/NIGhxxL9haQCBleWcrYAoLmI
CKWoRY8cQUvRimYpSnkSDc46
=Kl7t
-----END PGP SIGNATURE-----
