List all Workdays between two dates

[Stefan_Sand]

Hello,

i have to generate a vacation calendar for my department and i startet with some formulas to generate a unique list of vacation days for every team member via name manager. My problem now is, that the vacation list should only list the absent workdays between two dates, including start and end date.

To make it more comfortable, i took a little vba code, but it lists all days between two dates. How do i have to adopt it to list only the working days between the dates?

Code: Select all

Sub WriteVacation()
    'UpdatebyStefan
    Dim rng As Range
    Dim StartRng As Range
    Dim EndRng As Range
    Dim OutRng As Range
    Dim StartValue As Variant
    Dim EndValue As Variant
    xTitleId = "Vacation List"
    Set StartRng = Application.Selection
    Set StartRng = Application.InputBox("Start Range (single cell):", xTitleId, StartRng.Address, Type:=8)
    Set EndRng = Application.InputBox("End Range (single cell):", xTitleId, Type:=8)
    Set OutRng = Application.InputBox("Out put to (single cell):", xTitleId, Type:=8)
    Set OutRng = OutRng.Range("A1")
    StartValue = StartRng.Range("A1").Value
    EndValue = EndRng.Range("A1").Value
    If EndValue - StartValue <= 0 Then
        Exit Sub
        End If
        ColIndex = 0
        For i = StartValue To EndValue
            OutRng.Offset(ColIndex, 0) = i
            ColIndex = ColIndex + 1
        Next
    End Sub

[HansV]

Here you go:

Code: Select all

Sub WriteVacation()
    'UpdatebyStefan
    Dim StartRng As Range
    Dim EndRng As Range
    Dim OutRng As Range
    Dim StartValue As Date
    Dim EndValue As Date
    Const xTitleId = "Vacation List"
    Dim ColIndex As Long
    Set StartRng = Application.Selection
    Set StartRng = Application.InputBox("Start Range (single cell):", xTitleId, StartRng.Address, Type:=8)
    Set EndRng = Application.InputBox("End Range (single cell):", xTitleId, Type:=8)
    Set OutRng = Application.InputBox("Out put to (single cell):", xTitleId, Type:=8)
    Set OutRng = OutRng.Range("A1")
    ' Start value is first working day on or after StartRng
    StartValue = Application.WorkDay(StartRng.Range("A1").Value - 1, 1)
    ' StartValue = Application.WorkDay(StartRng.Range("A1").Value, 0)
    EndValue = EndRng.Range("A1").Value
    If EndValue <= StartValue Then
        Exit Sub
    End If
    ColIndex = 0
    Do While StartValue <= EndValue
        OutRng.Offset(ColIndex) = StartValue
        ColIndex = ColIndex + 1
        StartValue = Application.WorkDay(StartValue, 1)
    Loop
End Sub

If you have a range containing public holidays such as New Year's Day etc,, the code could easily be adapted to take that into account.

[Stefan_Sand]

Thank You Hans,

do you mean the networkdays function?

[HansV]

The code that I posted uses the WORKDAY worksheet function. WORKDAY(startdate, n) returns the date n working days after startdate. It can take a range of public holidays as a third argument.
We don't use NETWORKDAYS here - that function counts the number of working days between two dates.

By the way, I made a mistake in the line StartValue = Application.WorkDay(StartRng.Range("A1").Value, 0). It should have been

Code: Select all

    StartValue = Application.WorkDay(StartRng.Range("A1").Value - 1, 1)

[Stefan_Sand]

ok, thank You again.

[Stefan_Sand]

Hello, one last question to the topic vacation days,
the generated list gives me all workdays without holidays as i used in my formula solution.
Where do i have to put the named range "Feiertage" - holidays into the code to get out the "real" workdays between two dates?

Stefan

[HansV]

like this:

Code: Select all

Sub WriteVacation()
    'Update by Hans from Eileens lounge
    Dim StartRng As Range
    Dim EndRng As Range
    Dim OutRng As Range
    Dim StartValue As Date
    Dim EndValue As Date
    Const xTitleId = "Vacation List"
    Dim ColIndex As Long
    Set StartRng = Application.Selection
    Set StartRng = Application.InputBox("Start Range (single cell):", xTitleId, StartRng.Address, Type:=8)
    Set EndRng = Application.InputBox("End Range (single cell):", xTitleId, Type:=8)
    Set OutRng = Application.InputBox("Out put to (single cell):", xTitleId, Type:=8)
    Set OutRng = OutRng.Range("A1")
    ' Start value is first working day on or after StartRng
    StartValue = Application.WorkDay(StartRng.Range("A1").Value - 1, 1, Worksheets("FeiertagsListe").Range("FeierTage"))
    EndValue = EndRng.Range("A1").Value
    If EndValue <= StartValue Then
        Exit Sub
    End If
    ColIndex = 0
    Do While StartValue <= EndValue
        OutRng.Offset(ColIndex) = StartValue
        ColIndex = ColIndex + 1
        StartValue = Application.WorkDay(StartValue, 1, Worksheets("FeiertagsListe").Range("FeierTage"))
    Loop
End Sub

[Stefan_Sand]

cool thank you