Error with working days in a month

AnneM

New Member
Joined
Nov 13, 2015
Messages
27
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?


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

VBA Code:
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
 

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
Try adding the line marked +++ in the shown position:
VBA Code:
            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
 
Upvote 0
Try adding the line marked +++ in the shown position:
VBA Code:
            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.

VBA Code:
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
 
Upvote 0
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
VBA Code:
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"
 
Upvote 1
Solution
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
VBA Code:
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
 
Upvote 0
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
 
Upvote 0

Forum statistics

Threads
1,215,077
Messages
6,122,991
Members
449,094
Latest member
masterms

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top