Highlight Columns if the date falls to weekend or holidays

V

Vincent88

Active Member
Joined
Mar 5, 2021
Messages
382
Office Version
  1. 2019
Platform
  1. Windows
  2. Mobile
Hi All,
Please help to modify the code to make the column appearance change - the font to be red if the column date falls to holiday ; interior change to some color if it is weekend; and font to be black if it is weekdays.

VBA Code: 
Public Function IsHolWeekend(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) And _
               Year(InputDate) = Year(vR1) Then
               IsHolWeekend = 1
              
            ElseIf Weekday(InputDate) = 1 Or Weekday(InputDate) = 7 Then
               IsHolWeekend = 2
              
            Else
                IsHolWeekend = 0
                'Exit Function
            End If
        Next vR1
     End With
    
End Function

Sub HolidayandWeekend19()

    Dim vRng As Range
    Dim vLastRow As Long
    Dim vRngCol As Range
    
    With ThisWorkbook.ActiveSheet
        vLastRow = .Cells(Rows.Count, "A").End(xlUp).Row
        Set vRng = Range("C1", Range("AL" & vLastRow))
        For Each vRngCol In vRng.Columns
            If IsHolWeekend(vRngCol.Cells(1)) = 1 Then
                With Columns(vRngCol.Column)
                    .Font.Color = vbRed
                End With
            ElseIf IsHolWeekend(vRngCol.Cells(1)) = 2 Then
                With Columns(vRngCol.Column)
                    .Interior.Color = RGB(255, 245, 230)
                End With
            Else
               With Columns(vRngCol.Column)
                    .Font.Color = vbBlack
                End With
                
            End If
          
        Next vRngCol
    End With
    
 End Sub
 

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.
Sort by date Sort by votes
I don't enjoy macros much....
Mr Excel Playground 3.xlsm
ABCDEFGHIJKLMNOPQRSTUVWXYZAAABACADAEAFAGAHAIAJAKALAMANAOAPAQARASATAUAVAWAXAY
1Holidays1/1/20211/2/20211/3/20211/4/20211/5/20211/6/20211/7/20211/8/20211/9/20211/10/20211/11/20211/12/20211/13/20211/14/20211/15/20211/16/20211/17/20211/18/20211/19/20211/20/20211/21/20211/22/20211/23/20211/24/20211/25/20211/26/20211/27/20211/28/20211/29/20211/30/20211/31/20212/1/20212/2/20212/3/20212/4/20212/5/20212/6/20212/7/20212/8/20212/9/20212/10/20212/11/20212/12/20212/13/20212/14/20212/15/20212/16/20212/17/20212/18/20212/19/2021
21/1/2021
31/18/2021
42/15/2021
55/25/2021
67/4/2021
79/6/2021
810/15/2021
911/11/2021
1011/26/2021
1112/25/2021
Sheet17
Cells with Conditional Formatting
CellConditionCell FormatStop If True
B1:BD1Expression=WEEKDAY(B1,2)>5textYES
B1:BD1Expression=WORKDAY.INTL(B1-1,1,1,$A$2:$A$12)<>B1textNO
 
Upvote 0
After few changes...
VBA Code: 
Public Function IsHolWeekend(InputDate As Date) As Integer

    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) Then
               IsHolWeekend = 1
               GoTo EX
            ElseIf Weekday(InputDate) = 1 Or Weekday(InputDate) = 7 Then
               IsHolWeekend = 2
               GoTo EX
            Else
               IsHolWeekend = 0
               GoTo EX
            End If
        Next vR1

     End With
EX:

End Function
 
Upvote 0
Hi EXCEL MAX,
The code does not work. See image attached. The weekend hightlights are distorted and no font color change in those holidays.

VBA Code: 
Public Function IsHolWeekend20(InputDate As Date) As Integer

    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) And _
               Year(InputDate) = Year(vR1) Then
               IsHolWeekend20 = 1
               GoTo EX
            ElseIf Weekday(InputDate) = 1 Or Weekday(InputDate) = 7 Then
               IsHolWeekend20 = 2
               GoTo EX
            Else
               IsHolWeekend20 = 0
               GoTo EX
            End If
        Next vR1

     End With
EX:

End Function



Sub HolidayandWeekend20()

    Dim vRng As Range
    Dim vLastRow As Long
    Dim vRngCol As Range
    
    With ThisWorkbook.ActiveSheet
        
        vLastRow = .Cells(Rows.Count, "A").End(xlUp).Row
        Set vRng = Range("C1", Range("AL" & vLastRow))
        For Each vRngCol In vRng.Columns
            If IsHolWeekend20(vRngCol.Cells(1)) = 1 Then
                
                    vRngCol.Font.Color = vbRed
              
            ElseIf IsHolWeekend20(vRngCol.Cells(1)) = 2 Then
               vRngCol.Cells.Interior.Color = RGB(255, 245, 230)
                
            Else
              
                    vRngCol.Font.Color = vbBlack
            
                
            End If
          
        Next vRngCol
    End With
    
 End Sub
 

Attachments

  • holidaycolhighlight.png
    holidaycolhighlight.png
    48.9 KB · Views: 11
Upvote 0
I've got no time right now to look at workbook better,
but try to remove "Year(InputDate) = Year(vR1)" from IsHolWeekend function.
 
Upvote 0
@Vincent88 The following is what I came up with after moving some of your code around. See if it does what you initially wanted it to do.

VBA Code: 
Sub HolidayandWeekend19()
'
    Dim vRng        As Range
    Dim vLastRow    As Long
    Dim vRngCol     As Range
'
    With ThisWorkbook.ActiveSheet
        vLastRow = .Cells(Rows.Count, "A").End(xlUp).Row
'
        Set vRng = Range("C1", Range("AL" & vLastRow))
'
        For Each vRngCol In vRng.Columns
            If IsHolWeekend(vRngCol.Cells(1)) = True Then                               ' If Holiday then ...
                Columns(vRngCol.Column).Font.Color = vbRed
            ElseIf Weekday(vRngCol.Cells(1)) = 1 Or Weekday(vRngCol.Cells(1)) = 7 Then  ' If date is a weekend then ...
                Columns(vRngCol.Column).Interior.Color = RGB(255, 245, 230)
            Else
                Columns(vRngCol.Column).Font.Color = vbBlack                            ' date is a weekday
            End If
        Next vRngCol
    End With
End Sub


Public Function IsHolWeekend(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) And Year(InputDate) = Year(vR1) Then
                IsHolWeekend = True                                                         ' Set to True for Holiday
                Exit Function
            End If
        Next vR1
     End With
End Function
 
Upvote 0
Solution
Hi johnnyL,
this works better if the holiday coincides to weekend.
VBA Code: 
Sub HolidayandWeekend2()
'
    Dim vRng        As Range
    Dim vLastRow    As Long
    Dim vRngCol     As Range
'
    With ThisWorkbook.ActiveSheet
        vLastRow = .Cells(Rows.Count, "A").End(xlUp).Row
'
        Set vRng = Range("C1", Range("AL" & vLastRow))
'
        For Each vRngCol In vRng.Columns
            If Weekday(vRngCol.Cells(1)) = 7 And IsHolWeekend(vRngCol.Cells(1)) = True Then  'If holiday coincides with weekend
               vRngCol.Cells.Interior.Color = RGB(255, 245, 230)
               vRngCol.Font.Color = vbRed
            ElseIf Weekday(vRngCol.Cells(1)) = 1 Or Weekday(vRngCol.Cells(1)) = 7 Then       ' If date is a weekend then ...
                vRngCol.Cells.Interior.Color = RGB(255, 245, 230)
            ElseIf IsHolWeekend(vRngCol.Cells(1)) = True Then                                ' If Holiday then ...
                vRngCol.Font.Color = vbRed
            Else
                vRngCol.Font.Color = vbBlack                                                 ' date is a weekday
            End If
        Next vRngCol
    End With
End Sub
 
Upvote 0
Just FYI, your holiday/weekend combo is only checking one day of the weekend.
 
Upvote 0
You must log in or register to reply here.

Similar threads

R
  • Solved
Subtracting all calendar days, but end date cannot fall on a weekend or holiday. If it does, the end date shifts to the preceding work day.
Replies
8
Views
252
Romy
R
V
  • Solved
Apply worksheet function in module
2
Replies
10
Views
920
EXCEL MAX
EXCEL MAX
C
  • Question
Finding weekends and holidays within a date range
Replies
1
Views
329
ColinPearsonEIT
C
I
  • Solved
Find the Next non-Holiday Monday from a given date?
Replies
4
Views
636
Fluff
Fluff
JohnZ1156
  • Question
Check if date exists in entire Date column of Table4
Replies
1
Views
61
Tetra201
Tetra201

Forum statistics

Threads
1,215,110
Messages
6,123,143
Members
449,098
Latest member
Doanvanhieu

Share this page

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