J
jh
I would like to change the below code to calc BUSINESS
days plus allow for HOLIDAYS. Can anyone help me with
this?
Private Sub CalcOnSched()
Dim strMsg As String
Dim datTarget As Date, datStartDate As Date, datCurrent As
Date
Dim intLapsedDays As Integer, intOverDueDays As Integer
'Dim lngStatusColour As Long, lngGo As Long, lngRisk As
Long, lngCorAction As Long
datCurrent = Date
datStartDate = Me.Start
datTarget = DateAdd("d", Me.CommittedDays, datStartDate)
'Set colours using variables in case colours need to be
tweak later
'lngGo = vbGreen
'lngCorAction = vbYellow
'lngRisk = vbRed
If IsDate(Me.ActualEnd) Then
intOverDueDays = DateDiff("d", Me.ActualEnd,
datTarget)
intLapsedDays = DateDiff("d", datStartDate,
Me.ActualEnd)
Select Case intOverDueDays
Case Is < 0
strMsg = "Corrective Action"
' lngStatusColour = lngCorAction
Case Is = 0
strMsg = "On Target"
' lngStatusColour = lngGo
Case Is > 0
strMsg = "On Target"
' lngStatusColour = lngGo
End Select
Else
intOverDueDays = DateDiff("d", datCurrent, datTarget)
intLapsedDays = DateDiff("d", datStartDate,
datCurrent)
Select Case intOverDueDays
Case Is < 0
strMsg = "Risk"
' lngStatusColour = lngRisk
Case Is = 0
strMsg = "Now Due!"
' lngStatusColour = lngGo
' Case Is > 0
' strMsg = "On Schedule - " & intOverDueDays
& " days left"
' lngStatusColour = lngGo
Case Is > 0
strMsg = "On Target"
' lngStatusColour = lngGo
End Select
End If
Me.SLAStatus = strMsg
'Me.SLAStatus.BackColor = lngStatusColour
Me.LapsedDays = intLapsedDays
Me.OverdueDays = intOverDueDays
'Me.TargetDate = datTarget
'End If
End Sub
days plus allow for HOLIDAYS. Can anyone help me with
this?
Private Sub CalcOnSched()
Dim strMsg As String
Dim datTarget As Date, datStartDate As Date, datCurrent As
Date
Dim intLapsedDays As Integer, intOverDueDays As Integer
'Dim lngStatusColour As Long, lngGo As Long, lngRisk As
Long, lngCorAction As Long
datCurrent = Date
datStartDate = Me.Start
datTarget = DateAdd("d", Me.CommittedDays, datStartDate)
'Set colours using variables in case colours need to be
tweak later
'lngGo = vbGreen
'lngCorAction = vbYellow
'lngRisk = vbRed
If IsDate(Me.ActualEnd) Then
intOverDueDays = DateDiff("d", Me.ActualEnd,
datTarget)
intLapsedDays = DateDiff("d", datStartDate,
Me.ActualEnd)
Select Case intOverDueDays
Case Is < 0
strMsg = "Corrective Action"
' lngStatusColour = lngCorAction
Case Is = 0
strMsg = "On Target"
' lngStatusColour = lngGo
Case Is > 0
strMsg = "On Target"
' lngStatusColour = lngGo
End Select
Else
intOverDueDays = DateDiff("d", datCurrent, datTarget)
intLapsedDays = DateDiff("d", datStartDate,
datCurrent)
Select Case intOverDueDays
Case Is < 0
strMsg = "Risk"
' lngStatusColour = lngRisk
Case Is = 0
strMsg = "Now Due!"
' lngStatusColour = lngGo
' Case Is > 0
' strMsg = "On Schedule - " & intOverDueDays
& " days left"
' lngStatusColour = lngGo
Case Is > 0
strMsg = "On Target"
' lngStatusColour = lngGo
End Select
End If
Me.SLAStatus = strMsg
'Me.SLAStatus.BackColor = lngStatusColour
Me.LapsedDays = intLapsedDays
Me.OverdueDays = intOverDueDays
'Me.TargetDate = datTarget
'End If
End Sub