Home > Net >  How would I use the Excel application.workday function to skip weekends and holidays?
How would I use the Excel application.workday function to skip weekends and holidays?

Time:07-20

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.

  • Related