Include holidays in function code

[Vincent88]

Hi EveryOne,
I want to include the holidays in the function code. The holidays details is in Sheet("Data") dynamic table TableNew A2:last row of data.
Please help !!

Public Function IsWeekend(InputDate As Date) As Boolean
    Select Case Weekday(InputDate)
        Case vbSaturday, vbSunday
            IsWeekend = True
        Case Else
            IsWeekend = False
    End Select
End Function


Sub TAbsence13()
  Dim rng As Range
    Dim lastrow As Long
    Dim rngCol As Range
    Dim lastCol As Long
    
    lastrow = Cells(Rows.Count, "A").End(xlUp).Row
    lastCol = Cells(1, Columns.Count).End(xlToLeft).Column
    
    Set rng = Range("C1", Range("AL" & lastrow))
      
    For Each rngCol In rng.Columns
        rngCol.Cells(2).Font.Color = vbBlack

        If IsWeekend(rngCol.Cells(1)) = True Then
                rngCol.Cells(2).Font.Color = vbBlue
                  
        Else
                rngCol.Cells(2).Font.Color = vbBlack
        End If

    Next rngCol
    
 End Sub

 

[jorismoerings]

Hi,

In some cases questions are asked and solved multiple times. Hence it's always useful to search the forum to see if another users has a similar question which was solved.
With that intro it will be no surprise probably that is in this case also what happened.

See this and it will most probable needs some amending but it will give you direction, check this:

VBA to determine next working date excluding holiday List and WeekEnds

Hello Experts, I have a requirement where i need to update a column in excel with dates thats equal to todays Date + 2 days ahead (Ex: 4-Aug + 2 Days ahead). But the date must not be a weekend (Saturday and Sunday) and also none among the below shown holiday list. Suppose i am running this...

www.mrexcel.com

 

[Vincent88]

Hi jorismoerings, I searched many articles about my quest including the one that you mentioned of whice I do not understand the whole logic thus not capable to correct it to suit my need. The one that I found and used seems much simple and easier to understand. How about amending like this ?

Public Function IsWeekend(InputDate As Date) As Boolean
    Dim vbHoliday As Boolean
    Dim lastrowh As Long
        lastrowh = ThisWorkbook.Worksheets("Data").Cells(Rows.Count, "A").End(xlUp).Row
        vbHoliday = Application.Match(InputDate, ThisWorkbook.Worksheets("Data").Range("A2:A" & lastrowh).Value, 0)
    
    Select Case Weekday(InputDate)
        Case vbSaturday, vbSunday, vbHoliday
            IsWeekend = True
        Case Else
            IsWeekend = False
    End Select
            
End Function


Sub TAbsence13()
  Dim rng As Range
    Dim lastrow As Long
    Dim rngCol As Range
    Dim lastCol As Long
    
    lastrow = Cells(Rows.Count, "A").End(xlUp).Row
    lastCol = Cells(1, Columns.Count).End(xlToLeft).Column
    
    Set rng = Range("C1", Range("AL" & lastrow))
            
    For Each rngCol In rng.Columns
        rngCol.Cells(2).Font.Color = vbBlack

       'Debug.Print rngCol.Address
        If IsWeekend(rngCol.Cells(1)) = True Then
                rngCol.Cells(2).Font.Color = vbBlue
                  
        Else
                rngCol.Cells(2).Font.Color = vbBlack
        End If

    Next rngCol
    
 End Sub

 

[Vincent88]

Hi Everyone,
Can anyone can help me to rectify the code.

Option Explicit

Function FindWorkingDays(StartDate As Long, EndDate As Long, Optional InclSaturdays As Boolean = True, _
    Optional InclSundays As Boolean = True)

'Declaring variables
Dim RngFind As Range
Dim i As Long


For i = StartDate To EndDate
Set StartDate = ThisWorkbook.ActiveSheet.Range(1, 3)
Set EndDate = ThisWorkbook.ActiveSheet.Range(1, 38)

    
    On Error Resume Next
    
    'Finding the location where the specified date exist in the Holidays sheet
    Set RngFind = Worksheets("Data").Columns(1).Find(i)
    
    On Error GoTo 0
    
    'Checking whether it is holiday on the given date
    If Not RngFind Is Nothing Then
        GoTo ForLast
    End If
    
    'Checking whether it is Saturday on given date
    If InclSaturdays Then
        If Weekday(i, 2) = 6 Then
            GoTo ForLast
        End If
    End If
    
    'Checking whether it is Sunday on given date
    If InclSundays Then
        If Weekday(i, 2) = 7 Then
            GoTo ForLast
        End If
    End If
    
    FindWorkingDays = FindWorkingDays
ForLast:

Next

End Function
Sub FindWeekendCol14()
  Dim rng As Range
    Dim lastrow As Long
    Dim rngCol As Range
    Dim lastCol As Long
    
    lastrow = Cells(Rows.Count, "A").End(xlUp).Row
    lastCol = Cells(1, Columns.Count).End(xlToLeft).Column
    
    Set rng = Range("C1", Range("AL" & lastrow))
            
    For Each rngCol In rng.Columns
        rngCol.Cells(2).Font.Size = 12
      
        If FindWorkingDays(rngCol.Cells(1)) = True Then
                rngCol.Cells(2).Font.Size = 16
        Else
                rngCol.Cells(2).Font.Size = 12
        End If

    Next rngCol
    
 End Sub

 

[jorismoerings]

Hi,

Keep posting changed VBA scripts without context on what you're trying to do, isn't the way to get assistance.

If you could provide a part of your file (using XL2BB) or copy of a file (no sensitive data) that shows the problem by uploading to a file-share site and provide a link here that might enable us to investigate better.

 

[Vincent88]

This shows no error but does not work

Option Explicit

Function FindWorkingDays(InputDate As Long, Optional InclSaturdays As Boolean = True, _
    Optional InclSundays As Boolean = True)

'Declaring variables
Dim RngFind As Range

    On Error Resume Next

    Dim lastrowh As Long
       lastrowh = ThisWorkbook.Worksheets("Data").Cells(Rows.Count, "A").End(xlUp).Row
   
    'Finding the location where the specified date exist in the Holidays sheet
     Set RngFind = Worksheets("Data").Range("A2:A" & lastrowh).Find(InputDate)
   
    On Error GoTo 0
   
    'Checking whether it is holiday on the given date
    If Not RngFind Is Nothing Then
        GoTo ForLast
    End If
   
    'Checking whether it is Saturday on given date
    If InclSaturdays Then
        If Weekday(InputDate, 2) = 6 Then
            GoTo ForLast
        End If
    End If
   
    'Checking whether it is Sunday on given date
    If InclSundays Then
        If Weekday(InputDate, 2) = 7 Then
            GoTo ForLast
        End If
    End If
   
ForLast:
End Function


Sub FindWeekendCol14()
  Dim rng As Range
    Dim lastrow As Long
    Dim rngCol As Range
    Dim lastCol As Long
   
    lastrow = Cells(Rows.Count, "A").End(xlUp).Row
    lastCol = Cells(1, Columns.Count).End(xlToLeft).Column
   
    Set rng = Range("C1", Range("AL" & lastrow))
   
    For Each rngCol In rng.Columns
        rngCol.Cells(2).Font.Size = 12
   
        If FindWorkingDays(rngCol.Cells(1)) = True Then
               rngCol.Cells(2).Font.Size = 16
        Else
               rngCol.Cells(2).Font.Size = 12
        End If

    Next rngCol
   
 End Sub

Hi,

Keep posting changed VBA scripts without context on what you're trying to do, isn't the way to get assistance.

If you could provide a part of your file (using XL2BB) or copy of a file (no sensitive data) that shows the problem by uploading to a file-share site and provide a link here that might enable us to investigate better.

RosterWebv.xlsm
	A
1	Holidays (A2:End)
2	January 1, 2021
3	February 12, 2021
4	February 13, 2021
5	February 15, 2021
6	April 2, 2021
7	April 3, 2021
8	April 5, 2021
9	May 1, 2021
10	May 19, 2021
11	June 14, 2021
12	July 1, 2021
13	July 5, 2021
14	September 22, 2021
15	October 1, 2021
16	October 14, 2021
17	December 25, 2021
18	December 27, 2021
19	January 1, 2022
20	February 1, 2022
21	February 2, 2022
22	February 3, 2022
23	November 25, 2021
Data

RosterWebv.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z	AA	AB	AC	AD	AE	AF	AG	AH	AI	AJ	AK	AL	AM	AN	AO	AP	AQ	AR	AS	AT	AU	AV	AW	AX	AY	AZ	BA	BB
1	MDate	Attendance	26-Jun	27-Jun	28-Jun	29-Jun	30-Jun	1-Jul	2-Jul	3-Jul	4-Jul	5-Jul	6-Jul	7-Jul	8-Jul	9-Jul	10-Jul	11-Jul	12-Jul	13-Jul	14-Jul	15-Jul	16-Jul	17-Jul	18-Jul	19-Jul	20-Jul	21-Jul	22-Jul	23-Jul	24-Jul	25-Jul	26-Jul	27-Jul	28-Jul	29-Jul	30-Jul	31-Jul	Total D	Total D4	Total G	Total D2	Total E	Total N	Total O	Total AL	Total AM	Total PM	Total MI	Total LE	Total ATTN	Total Weekends	Total Holidays	Total Workdays
2	Date	Summary	(5)	(4)	(3)	(2)	(1)	1	2	3	4	5	6	7	8	9	10	11	12	13	14	15	16	17	18	19	20	21	22	23	24	25	26	27	28	29	30	31	D	D4	G	D2	E	N	O	AL	AM	PM	MI	Column1	ATTN	Weekends	Holidays	WorkDays
3	Cat G	#NAME?																																					0	0	0	0	0	0	0	0	0	0	0	0	0	9	2	20
4	Mathew Y	#NAME?																																					0	0	0	0	0	0	0	0	0	0	0	0	0	9	2	20
5	John W	#NAME?																																					0	0	0	0	0	0	0	0	0	0	0	0	0	9	2	20
6	Robert H	#NAME?																																					0	0	0	0	0	0	0	0	0	0	0	0	0	9	2	20
7	Man L	#NAME?																																					0	0	0	0	0	0	0	0	0	0	0	0	0	9	2	20
8	Vincent M	#NAME?																																					0	0	0	0	0	0	0	0	0	0	0	0	0	9	2	20
9	Jeffrey L	#NAME?																																					0	0	0	0	0	0	0	0	0	0	0	0	0	9	2	20
10	Zita Y	#NAME?																																					0	0	0	0	0	0	0	0	0	0	0	0	0	9	2	20
11	Cat G	#NAME?																																					0	0	0	0	0	0	0	0	0	0	0	0	0	9	2	20
12	Jason J	#NAME?																																					0	0	0	0	0	0	0	0	0	0	0	0	0	9	2	20
13	Vince M	#NAME?																																					0	0	0	0	0	0	0	0	0	0	0	0	0	9	2	20
14	Roy L	#NAME?																																					0	0	0	0	0	0	0	0	0	0	0	0	0	9	2	20
202107

Cell Formulas
Range	Formula
AY1,AQ1:AW1,AM1:AO1	AM1	="Total "&AM2
AW3:AW14,AM3:AT14	AM3	=COUNTIF($H3:$AL3,AM$2)
AU3:AV14	AU3	=COUNTIF($H3:$AL3,AU$2)/2
AX3:AX14	AX3	=SUM(Table2[@[AL]:[MI]])
AY3:AY14	AY3	=SUM(AM3:AW3)
AZ3:AZ14	AZ3	=(EOMONTH(H$1,0)-H$1)-NETWORKDAYS(H$1,EOMONTH(H$1,0))+1
BA3:BA14	BA3	=NETWORKDAYS(H$1,EOMONTH(H$1,0))-NETWORKDAYS(H$1,EOMONTH(H$1,0),TableNew[Holidays (A2:End)])
BB3:BB14	BB3	=NETWORKDAYS(H$1,EOMONTH(H$1,0),TableNew[Holidays (A2:End)])
B3:B14	B3	=_xlfn.TEXTJOIN(,TRUE,"T:"&BB3," ","L:",SUM(AT3:AW3), " ","D:",SUM(AM3:AP3)," ","E:",AQ3," ","N:",AR3)

Named Ranges
Name	Refers To	Cells
HolidaysNew	=TableNew[Holidays (A2:End)]	BA3:BB14

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
B3:B14	Expression	=SUM(AM3:AR3)<BB3	text	NO
C1:AL14	Expression	=WEEKDAY(C$1,2)>5	text	NO
C1:AL14	Expression	=COUNTIF(HolidaysNew,C$1)	text	NO
B3	Expression	=SUM(AM3:AR3)>BB3	text	NO
G3,E3:F14	Expression	=SUM(AL3:AQ3)>BA3	text	NO
G4:G14	Expression	=SUM(AN4:AS4)>BC4	text	NO
BA14	Cell Value	>0	text	NO
BA1,BA3:BA14	Cell Value	>0	text	NO
B4:B14	Expression	=SUM(AM4:AR4)>BB4	text	NO
C3:D14	Expression	=SUM(AJ3:AN3)>AY3	text	NO

Cells with Data Validation
Cell	Allow	Criteria
H3:AL14	List	=ShiftcodeNew
A3:A13	List	=HelpAgent
A14	List	=HelpAgent

 

[EXCEL MAX]

Hello Vincent 88,
according to your first post I understand you want to highlight columns if they begin with weekend or
they begin with some of holydays specified in the column "A".
If I'm right you can try this...

Public Function IsWeekend(InputDate As Date) As Boolean

    Dim vLastRow As Long
    Dim vR1 As Range

    With ThisWorkbook.Worksheets("Data")
        vLastRow = .Cells(Rows.Count, "A").End(xlUp).Row
        For Each vR1 In .Range("A2:A" & vLastRow)
            If Day(InputDate) = Day(vR1) And _
               Month(InputDate) = Month(vR1) Or _
               Weekday(InputDate) = 1 Or _
               Weekday(InputDate) = 7 Then
               IsWeekend = True
               Exit Function
            Else
                IsWeekend = False
            End If
        Next vR1
     End With
     
End Function


Sub TAbsence13()

    Dim vRng As Range
    Dim vLastRow As Long
    Dim vRngCol As Range
    
    With ThisWorkbook.Worksheets("Data")
        vLastRow = .Cells(Rows.Count, "A").End(xlUp).Row
        Set vRng = Range("C1", Range("AL" & vLastRow))
        For Each vRngCol In vRng.Columns
            If IsWeekend(vRngCol.Cells(1)) = True Then
                With Columns(vRngCol.Column)
                    .Font.Color = vbBlue
                End With
            Else
                With Columns(vRngCol.Column)
                   .Font.Color = vbBlack
                End With
            End If
        Next vRngCol
    End With
    
 End Sub

 

[Vincent88]

Hi EXCEL MAX,
Thank you for code. In fact there are two sheets to work with. One sheet "Data" contains the holidays and the other is the calendar sheet to apply the module, I changed
With ThisWorkbook.Worksheets("Data") to With ThisWorkbook.Activesheet to make it works.
Based on your advice, I work further to apply worksheetfunction to it but encounter difficulty, I post my quest in another thread (Apply worksheet function in module). Hope you can help again. Thanks.