View Single Post
 
Old 01-04-2021, 11:13 PM
gmayor's Avatar
gmayor gmayor is offline Windows 10 Office 2016
Expert
 
Join Date: Aug 2014
Posts: 4,101
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
Default

Well it could certainly be simplified
Code:
Option Explicit

Sub Macro6()
'The Idea is to Find Weekdays, then find Holidays that are Weekdays
'Graham Mayor - https://www.gmayor.com - Last updated - 05 Jan 2021
Dim Count As Integer
Dim TestDay As Date
Dim sMessage As String
Dim vHolidays As Variant
Dim i As Integer, j As Integer
Dim oRng As Range
Dim dDate As DataObject

vHolidays = Array("01/01/21", "01/02/21", "01/30/21")    'add the holidays to the array

    Count = 14
    TestDay = Date    'CDate("01/01/21")

    For i = 1 To 14
        If Weekday(TestDay + i) = 1 Or Weekday(TestDay + i) = 7 Then
            Count = Count + 1
            'if added day is at the weekend add another day
            If Weekday(TestDay + Count) = 1 Or Weekday(TestDay + Count) = 7 Then Count = Count + 1
        End If
    Next i

    For j = 0 To UBound(vHolidays)
        If TestDay = CDate(vHolidays(j)) Then
            Count = Count + 1
            'probably unnecessary but if added day is at the weekend add another day
            If Weekday(TestDay + Count) = 1 Or Weekday(TestDay + Count) = 7 Then Count = Count + 1
        End If
    Next j

    TestDay = DateAdd("d", Count, TestDay)     'Add count to TestDay

    Selection.TypeText TestDay    'optional as the date is written to the clipboard

    Set dDate = New DataObject
    dDate.SetText TestDay
    dDate.PutInClipboard

    sMessage = "14 Working Days from Today - " & TestDay
    MsgBox sMessage, vbInformation, "Add working days"
    Set dDate = Nothing
End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote