I am wondering how I would use application.workday function in Excel VBA to specify that the calculation of dates within my code cannot fall on a weekend or holiday
this is my code :
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Columns(46)) Is Nothing Then
If Target.Cells(1).Value = "Performed Audit" Then
Me.Cells(Target.Row, "J").Value = "Performed"
Me.Cells(Target.Row, "K").Value = "Performed"
Me.Cells(Target.Row, "AS").Value = "Post-Audit"
Me.Cells(Target.Row, "AU").Value = Format(Me.Cells(Target.Row, "N"), "mm/dd/yyyy HH:mm:ss")
Me.Cells(Target.Row, "AV").Value = "Issue Audit Report"
Me.Cells(Target.Row, "AW").Value = Format(Me.Cells(Target.Row, "N") 20, "mm/dd/yyyy
HH:mm:ss")
Me.Cells(Target.Row, "AZ").Value = Format(Me.Cells(Target.Row, "N") 20, "mm/dd/yyyy
HH:mm:ss")
Me.Cells(Target.Row, "BA").Value = Format(Me.Cells(Target.Row, "N") 20, "mm/dd/yyyy
HH:mm:ss")
End If
End Sub
And in particular, the dates that are being calculated by the addition of 20 days cannot fall on a weekend or one of the holidays shown below
Labor Day Mon, 2022-09-05,
Thanksgiving Thu, 2022-11-24,
Day after Thanksgiving Fri, 2022-11-25,
Christmas Day (Observed) Fri, 2022-12-23,
Holiday Break Mon, 2022-12-26,
Holiday Break Tue, 2022-12-27,
Holiday Break Wed, 2022-12-28,
Holiday Break Thu, 2022-12-29,
Holiday Break Fri, 2022-12-30
CodePudding user response:
Please, try the next updated event. It uses evaluated Excel function WORKDAY.INTL
. Since, WORKDAY.INTL
does not return time (it returns a long equivalent of a day, not a Double containing time, too) I used a trick, extracting the time from the evaluated cell and added after evaluation:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim arrHolidays, tmp As Single, rngN As Range, d As Date
If Not Intersect(Target, Me.Columns(46)) Is Nothing Then
If Target.cells(1).value = "Performed Audit" Then
'place in an array all national holidays:
arrHolidays = Array(CLng(CDate("2022-09-05")), CLng(CDate("2022-11-24")), CLng(CDate("2022-11-25")), CLng(CDate("2022-12-23")), _
CLng(CDate("2022-12-26")), CLng(CDate("2022-12-28")), CLng(CDate("2022-12-29")), CLng(CDate("2022-12-30")))
On Error GoTo SafeExit
Set rngN = Me.cells(Target.row, "N"): d = rngN.value
tmp = CDbl(d) - Int(d) 'place the time in a variable. Workday does not return hours, minutes, seconds...
Application.EnableEvents = False: Application.Calculation = xlCalculationManual
Me.cells(Target.row, "J").value = "Performed"
Me.cells(Target.row, "K").value = "Performed"
Me.cells(Target.row, "AS").value = "Post-Audit"
Me.cells(Target.row, "AU").value = Format(Me.cells(Target.row, "N"), "mm/dd/yyyy HH:mm:ss")
Me.cells(Target.row, "AV").value = "Issue Audit Report"
Me.cells(Target.row, "AW").value = Format(Evaluate("WORKDAY.INTL(" & Me.cells(Target.row, "N").Address & _
",20,1,{" & Join(arrHolidays, ",") & "})") tmp, "mm/dd/yyyy HH:mm:ss")
Me.cells(Target.row, "AZ").value = Format(Evaluate("WORKDAY.INTL(" & Me.cells(Target.row, "N").Address & _
",20,1,{" & Join(arrHolidays, ",") & "})") tmp, "mm/dd/yyyy HH:mm:ss")
Me.cells(Target.row, "BA").value = Format(Evaluate("WORKDAY.INTL(" & Me.cells(Target.row, "N").Address & _
",20,1,{" & Join(arrHolidays, ",") & "})") tmp, "mm/dd/yyyy HH:mm:ss")
Application.EnableEvents = True: Application.Calculation = xlCalculationAutomatic
End If
End If
Exit Sub
SafeExit: 'reenable events in case of an error:
Application.EnableEvents = True
MsgBox err.Description, vbCritical, err.Number
End Sub
Or without Evaluate
, using WorkDay_Intl and Holidays array as it is. More compact and only standard VBA:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Columns(46)) Is Nothing Then
Dim arrHolidays, tmp As Single, rngN As Range, d As Date
If Target.cells(1).value = "Performed Audit" Then
'place in an array all national holidays:
arrHolidays = Array(CLng(CDate("2022-09-05")), CLng(CDate("2022-11-24")), CLng(CDate("2022-11-25")), CLng(CDate("2022-12-23")), _
CLng(CDate("2022-12-26")), CLng(CDate("2022-12-28")), CLng(CDate("2022-12-29")), CLng(CDate("2022-12-30")))
On Error GoTo SafeExit
Set rngN = Me.cells(Target.row, "N"): d = rngN.value
tmp = CDbl(d) - Int(d) 'place the time in a variable. Workday does not return hours, minutes, seconds...
Application.EnableEvents = False: Application.Calculation = xlCalculationManual
Me.cells(Target.row, "J").value = "Performed"
Me.cells(Target.row, "K").value = "Performed"
Me.cells(Target.row, "AS").value = "Post-Audit"
Me.cells(Target.row, "AU").value = Format(Me.cells(Target.row, "N"), "mm/dd/yyyy HH:mm:ss")
Me.cells(Target.row, "AV").value = "Issue Audit Report"
Me.cells(Target.row, "AW").value = Format(WorksheetFunction.WorkDay_Intl(d, 20, 1, arrHolidays) tmp, "mm/dd/yyyy HH:mm:ss")
Me.cells(Target.row, "AZ").value = Format(WorksheetFunction.WorkDay_Intl(d, 20, 1, arrHolidays) tmp, "mm/dd/yyyy HH:mm:ss")
Me.cells(Target.row, "BA").value = Format(WorksheetFunction.WorkDay_Intl(d, 20, 1, arrHolidays) tmp, "mm/dd/yyyy HH:mm:ss")
Application.EnableEvents = True: Application.Calculation = xlCalculationAutomatic
End If
End If
Exit Sub
SafeExit: 'reenable events in case of an error:
Application.EnableEvents = True: Application.Calculation = xlCalculationAutomatic
MsgBox err.Description, vbCritical, err.Number
End Sub
Please, send some feedback after testing it.