Error with working days in a month

[AnneM]

Hi,

Hoping someone can help with a problem I'm having with some code:

I have a workbook that includes a separate sheet for each month, as well as another sheet that lists the different public/bank holidays for each of the UK countries.

There is a user form that selects the country, and another that stipulates the start month (and thus the first month in the sequence), with the other 11 months following chronologically.

The code then adds the working days (date) to row 6 (C6:X6), excluding the location dependant Bank Holidays. It then loops through the rest of the sheets and adds the work days (Mon-Fri) for each month.

What is happening though, is that for some months (Feb, April, June, Sept) it adds the first day of the following month after the last day of that particular month. It doesn't seem to matter which cell that falls into either.

The 1st working day of the following month is added correctly, so Mar, May, July and Oct are fine.

Can anybody spot the problem with this?


========================

Sub AddDatesToMonthSheets(sheetNames As Variant, holidayColumn As Variant, startPos As Integer)
    Dim ws As Worksheet
    Dim dayNum As Integer
    Dim dayDate As Date
    Dim col As Integer
    Dim holidays As Range
    Dim nextWorkDay As Variant
    Dim monthPos As Integer

    
   ' Determine the holiday column based on the location selected in the frmLocationSelector form
    Select Case CStr(frmLocationSelector.cmbLocations.Value)
        Case "England & Wales"
            holidayColumn = "A"
        Case "Scotland"
            holidayColumn = "B"
        Case "Northern Ireland"
            holidayColumn = "C"
    End Select
    
    ' Set the range of holidays based on the selected column
    Set holidays = Sheets("Holidays").Range(holidayColumn & ":" & holidayColumn)
    
    monthPos = startPos
    
    ' Loop through all the sheets
    For Each ws In ThisWorkbook.Sheets
        ' Check if the sheet is one of the month sheets
        If IsInArray(ws.Name, sheetNames) Then
            ' Clear the previous dates in row 6
            ws.Range("C6:W6").ClearContents
            ' Initialize the date column
            col = 3 ' Column C
            ' Loop through all the days of the month
            For dayNum = 1 To 31
                ' Try to create a date with the day and the month
                On Error Resume Next
               dayDate = DateSerial(IIf(monthPos >= startPos, Year(Now), Year(Now) + 1), Application.Match(ws.Name, sheetNames, 0), dayNum)
               On Error GoTo 0
                ' If the dayDate is valid
                If IsDate(dayDate) Then
                    ' Try to get the next working day
                    On Error Resume Next
                    nextWorkDay = CDate(Application.WorksheetFunction.WorkDay(dayDate - 1, 1, holidays))
                    On Error GoTo 0
                    ' If the next working day is the same as dayDate
                    If IsDate(nextWorkDay) And nextWorkDay = dayDate Then
                        ' Add the dayDate to the row 6
                        ws.Cells(6, col).Value = dayDate
                        ' Move to the next column
                        col = col + 1
                    End If
                End If
            Next dayNum
            ' Increment monthPos
            monthPos = monthPos Mod 12 + 1
        End If
    Next ws
End Sub

 

[Anthony47]

Try adding the line marked +++ in the shown position:

            If IsDate(dayDate) Then
                If dayNum > 1 And (Month(dayDate) <> Month(ws.Range("C6"))) Then Exit For    '++++
                    ' Try to get the next working day
                    ' Your code

 

[AnneM]

Try adding the line marked +++ in the shown position:

            If IsDate(dayDate) Then
                If dayNum > 1 And (Month(dayDate) <> Month(ws.Range("C6"))) Then Exit For    '++++
                    ' Try to get the next working day
                    ' Your code

Hi Anthony

and thank you for your response.

I added the code you suggested and it fixed the problem with the 1st day of the following month being incorrectly used, but now what happens is that 4 of the sheets (April, June, September, January) have no dates in them at all.

If I reorder the sheets to begin with December 2024, followed by Jan thru November 2025, then Jan, Feb, Mar, June and November have no dates in row 6.

I've added the code below and would be very grateful if you would just check that I added your amendment in the right place and didn't create a conflict.

Thanks again.

Sub AddDatesToMonthSheets(sheetNames As Variant, holidayColumn As Variant, startPos As Integer)
    Dim ws As Worksheet
    Dim dayNum As Integer
    Dim dayDate As Date
    Dim col As Integer
    Dim holidays As Range
    Dim nextWorkDay As Variant
    Dim monthPos As Integer

    
   ' Determine the holiday column based on the location selected in the frmLocationSelector form
    Select Case CStr(frmLocationSelector.cmbLocations.Value)
        Case "England & Wales"
            holidayColumn = "A"
        Case "Scotland"
            holidayColumn = "B"
        Case "Northern Ireland"
            holidayColumn = "C"
    End Select
    
    ' Set the range of holidays based on the selected column
    Set holidays = Sheets("Holidays").Range(holidayColumn & ":" & holidayColumn)
    
    monthPos = startPos
    
    ' Loop through all the sheets
    For Each ws In ThisWorkbook.Sheets
        ' Check if the sheet is one of the month sheets
        If IsInArray(ws.Name, sheetNames) Then
            ' Clear the previous dates in row 6
            ws.Range("C6:X6").ClearContents
            ' Initialize the date column
            col = 3 ' Column C
            ' Loop through all the days of the month
            For dayNum = 1 To 31
                ' Try to create a date with the day and the month
                On Error Resume Next
               dayDate = DateSerial(IIf(monthPos >= startPos, Year(Now), Year(Now) + 1), Application.Match(ws.Name, sheetNames, 0), dayNum)
                On Error GoTo 0
                ' If the dayDate is valid
                ' If IsDate(dayDate) Then
                If IsDate(dayDate) Then
                If dayNum > 1 And (Month(dayDate) <> Month(ws.Range("C6"))) Then Exit For
                    ' Try to get the next working day
                    On Error Resume Next
                    nextWorkDay = CDate(Application.WorksheetFunction.WorkDay(dayDate - 1, 1, holidays))
                    On Error GoTo 0
                    ' If the next working day is the same as dayDate
                    If IsDate(nextWorkDay) And nextWorkDay = dayDate Then
                        ' Add the dayDate to the row 6
                        ws.Cells(6, col).Value = dayDate
                        ' Move to the next column
                        col = col + 1
                    End If
                End If
            Next dayNum
            ' Increment monthPos
            monthPos = monthPos Mod 12 + 1
        End If
    Next ws
End Sub

 

[Anthony47]

You inserted the line at the correct position.

Sorry, I have not a clear idea on the overall flow of your macro nor how your sheets are organized.
My only suggestion is try modifying the "1" in my added line to 15, ie

If dayNum > 15 And (Month(dayDate) <> Month(ws.Range("C6"))) Then Exit For

If this fails, then try to apply the concept "If the month of the new day is different from the month of this worksheet then exit the loop and move on to the next worksheet"

 

[AnneM]

You inserted the line at the correct position.

Sorry, I have not a clear idea on the overall flow of your macro nor how your sheets are organized.
My only suggestion is try modifying the "1" in my added line to 15, ie

If dayNum > 15 And (Month(dayDate) <> Month(ws.Range("C6"))) Then Exit For

If this fails, then try to apply the concept "If the month of the new day is different from the month of this worksheet then exit the loop and move on to the next worksheet"

Thank you so much Anthony, that change worked and the document is now good.

I really appreciate your help

 

[Anthony47]

Thank you for the feedback

If I reorder the sheets to begin with December 2024, followed by Jan thru November 2025, then Jan, Feb, Mar, June and November have no dates in row 6.

My understanding was that, in yout test situation, those months have day 1 as a non-working-day
The new code will work unless all the first 15 days of a month are non-working-days. If you think that could happen then increase "15" up to 27