CODEWITHSUNDEEP
excelvba
Chris R
Chris R

Reputation: 13

Excel VBA count non business days/weekend days

**Hello all, I have a question that is ½ about the code and ½ about the logic behind the code.

Background:

This is a vary small part of one Sub in a large workbook collection. The goal of this bit of code is to accept a user input for the number of business days they want to look out for a date range. Determine if the dates between contain weekend days, if so, add 2 to the range. The input is data type Integer. The number is added to the current date to get the last date in the range and assigned to dDate for use in this and other Sub’s.

What the code should do:

The most a user can request to look out for is 14 (don’t need error handling for more then 14). The request can be made any day of the week including weekends. If a request is made on Wednesday to look out 3 business days, the program should add 2 to show Thursday, Friday, Saturday, Sunday, and Monday. If the request is made on a Saturday to show 2 business days the program should add 1 to show Sunday, Monday, and Tuesday. If the number requested has 2 weekends between the range (8-14) then add 4.

So in short, for every weekend day in the date range, add one day to the user input number.

Please explain any responses with in code comments for all VBA skill levels. Both Code and logic help is welcome. **

'prompt to enter number of days to look out for shortage, new addition to the code added to expand usability
iNumDays = Application.InputBox(prompt:="Enter number of business days to look out for")

iweekday = Weekday(Date, vbMonday) 'get todays weekday number 1-7 with Monday being 1, Sunday being 7

'if today is Thursday or Friday the next 2 business days fall on the weekend, if so then we need to look out 2 days more
If iweekday > 3 Then 'iweekday is integer of todays weekday number, if its past Wednesday then enter If

    iNumDays = iNumDays + 2 'add 2 to user input
End If

dDate = Date + iNumDays    'add user day to look out input to todays date to get last date in desired date range             'get the column header for the date we are looking out to

Upvotes: 1

Views: 1027

Answers (3)

Marcucciboy2
Marcucciboy2

Reputation: 3259

Here is @Pm Duda's response reworked for VBA instead of VB.net

Private Function GetTotalDaysCountFromBusinessDays(ByVal dateStart As Date, ByVal busDaysInput As Long) As Long
    
    Dim daysTotal As Long
    Dim daysBusiness As Long
    
    Do While daysBusiness < busDaysInput
        daysTotal = daysTotal + 1
        
        If Weekday(DateAdd("d", dateStart, daysTotal)) <> vbSaturday _
        And Weekday(DateAdd("d", dateStart, daysTotal)) <> vbSunday Then
            daysBusiness = daysBusiness + 1
        End If
    Loop
    
    GetTotalDaysCountFromBusinessDays = daysTotal
    
End Function

Upvotes: 0

Pm Duda
Pm Duda

Reputation: 740

Solution found here: https://www.experts-exchange.com/questions/23461938/VB-net-Add-Days-to-a-Date.html

Public Function AddNBusinessDays(ByVal startDate As DateTime, ByVal numDays As Integer) As DateTime

    If numDays = 0 Then Return New DateTime(startDate.Ticks)

    If numDays < 0 Then Throw New ArgumentException()

    Dim totalDays As Integer
    Dim businessDays As Integer

    totalDays = 0
    businessDays = 0

    Dim currDate As DateTime
    While businessDays < numDays
        totalDays += 1

        currDate = startDate.AddDays(totalDays)

        If Not (currDate.DayOfWeek = DayOfWeek.Saturday Or currDate.DayOfWeek = DayOfWeek.Sunday) Then
            businessDays += 1
        End If

    End While

    Return currDate

End Function

Upvotes: 0

ComradeMicha
ComradeMicha

Reputation: 126

The most intuitive way to do this (in my opinion) is to simply count the days forward one by one until you added as many work days as requested by the user. The 14 days limit is not necessary anyways, as it is a loop that works with any integer up to billions of days...

Sub adddays()

Dim iNumDays As Integer
Dim iWeekDay As Integer
Dim dDate As Date

'prompt to enter number of days to look out for shortage, new addition to the code added to expand usability
iNumDays = Application.InputBox(prompt:="Enter number of business days to look out for")

dDate = Date                            ' initialize dDate with today's date before entering the counting loop

While iNumDays > 0                      ' as long as the there are still workdays left to add, repeat this
    dDate = dDate + 1                   ' move calendar forward by one day
    iWeekDay = Weekday(dDate, vbMonday) ' check what weekday we arrived at
    If iWeekDay < 6 Then                ' if we're looking at a working day, we successfully added one of the desired weekdays to be added
        iNumDays = iNumDays - 1
    End If
Wend

MsgBox ("Target date is: " & Str(dDate)) 'check results of the calculation or replace with whatever other logic you want here

End Sub

Upvotes: 1

Related Questions