How to highlight target holidays in a calendar in VBA and hyperlink task worksheets with business day only

Question

The target is that I am making a small tool to be made in VBA Excel.

The task description is as follows:

1- Make a function in VBA code which would highlight the fixed holidays in the provided Calendar (New Year 01/01 , Labor Day 01/05 , Christmas Day 25/12 , Christmas Holiday 26/12)

2-Make a function in VBA code which would highlight the floating holidays in the provided Calendar (Easter Monday,Good Friday).

3-The worksheets in the workbook should be hyperlinked through the VBA code to a Business day ( Business days are from "Monday to Friday") , there is a condition here too. If the Business day in future calendar happen to be a Fixed Holiday or the Floating Holiday e.g There is New Year on a Tuesday so there would be a holiday observed, in such scenario the worksheet should not be available for this holiday date. In other words, the worksheets have tasks which are to be performed on Business Days only.So if there is a Holiday (irrespective of Fixed or Floating Holiday) the task worksheet containing the task information would not be available.

My issue is that I dont have much of knowledge in VBA.Through internet searches I have found the functions but how to integrate them to achieve the above?

My code and so far found stuff is following:

Public Sub Worksheet_Change(ByVal Target As Range)



Dim mth As Integer, b As Integer, dt As Integer, M As Integer, x As Integer, _
w As Integer, Y As Integer, Days As Integer, iRow As Integer
Dim dateDay1 As Date, dateLeapYear As Date, calYearCell As Range
Dim ws As Worksheet
Dim monthName(1 To 12) As String, weekDay(1 To 7) As String







On Error GoTo ResetApplication
'will enable events (worksheet change) on error






'check validity of worksheet name:
 If Not ActiveSheet.Name = "Calendar" Then
 MsgBox "Please name worksheet as 'Calendar' to continue"
 Exit Sub
 End If











  Set ws = Worksheets("Calendar")

  'address of cell/range which contains Calendar Year:
   Set calYearCell = ws.Range("H7")









  'At least one cell of Target is within the range - calYearCell:
   If Not Application.Intersect(Target, calYearCell) Is Nothing Then







'turn off some Excel functionality so the code runs faster
 Application.DisplayAlerts = False
 Application.ScreenUpdating = False
 Application.EnableEvents = False
 Application.DisplayStatusBar = False
 Application.Calculation = xlCalculationManual







 If calYearCell = "" Then
 MsgBox "Select Year to Generate Calendar"
 GoTo ResetApplication
 Exit Sub
 End If

 'clear first 7 columns and any previous calendar:
  ws.Range("A:G").Clear




  D = 0

 'set names of 12 months for the array monthName:
  monthName(1) = "January"
  monthName(2) = "February"
  monthName(3) = "March"
  monthName(4) = "April"
  monthName(5) = "May"
  monthName(6) = "June"
  monthName(7) = "July"
  monthName(8) = "August"
  monthName(9) = "September"
  monthName(10) = "October"
  monthName(11) = "November"
  monthName(12) = "December"








  'set names of 7 week days for the array weekDay:
   weekDay(1) = "Monday"
   weekDay(2) = "Tuesday"
   weekDay(3) = "Wednesday"
   weekDay(4) = "Thursday"
   weekDay(5) = "Friday"
   weekDay(6) = "Saturday"
   weekDay(7) = "Sunday"








    For mth = 1 To 12
   'for each of the 12 months in a year

    counter = 1

   'determine day 1 for each month:
   If mth = 1 Then

   dateDay1 = "1/1/" & calYearCell
   wkDay = Application.Text(dateDay1, "dddd")







  If wkDay = "Monday" Then
  firstDay = 1
  ElseIf wkDay = "Tuesday" Then
  firstDay = 2
  ElseIf wkDay = "Wednesday" Then
  firstDay = 3
  ElseIf wkDay = "Thursday" Then
   firstDay = 4
   ElseIf wkDay = "Friday" Then
  firstDay = 5
   ElseIf wkDay = "Saturday" Then
   firstDay = 6
   ElseIf wkDay = "Sunday" Then
   firstDay = 7
   End If

    Else
   firstDay = firstDay
    End If









   'determine number of days in each month and the leap year:
    dateLeapYear = "2/1/" & calYearCell

    M = month(dateLeapYear)
   Y = Year(dateLeapYear)

    Days = DateSerial(Y, M + 1, 1) - DateSerial(Y, M, 1)


   If mth = 1 Or mth = 3 Or mth = 5 Or mth = 7 Or mth = 8 Or mth = 10 Or mth = 12 Then
   mthDays = 31
  ElseIf mth = 2 Then
  If Days = 28 Then
  mthDays = 28
  ElseIf Days = 29 Then
  mthDays = 29
 End If`Else
 mthDays = 30
 End If

`

  'determine last used row:
  If mth = 1 Then
   iRow = 0
   Else
 iRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
  End If


  dt = 1

  'maximum of 6 rows to accomodate all days of a month:
  For i = 1 To 6

  '7 columns for each week day of Monday to Sunday:
  For b = 1 To 7

  'enter name of the month:
  ws.Cells(iRow + 1, 1) = monthName(mth)
  ws.Cells(iRow + 1, 1).Font.Color = RGB(0, 0, 200)
 ws.Cells(iRow + 1, 1).Font.Bold = True
 ws.Range("A" & iRow + 1 & ":G" & iRow + 1).Interior.Color = RGB(191, 191, 191)
 ws.Range("A" & iRow + 1 & ":G" & iRow + 1).Borders(xlEdgeTop).LineStyle = XlLineStyle.xlContinuous

   'enter week day (Monday, Tuesday, ...):
   ws.Cells(iRow + 2, b) = weekDay(b)
   ws.Range("A" & iRow + 2 & ":G" & iRow + 2).Font.Bold = True
  ws.Range("A" & iRow + 2 & ":G" & iRow + 2).Interior.Color = RGB(0, 5000, 0)
  ws.Range("F" & iRow + 2 & ":G" & iRow + 2).Interior.Color = RGB(5000, 0, 0)


  'enter each date in a month:
  If dt <= mthDays Then

   'dates placement for the first row (for each month):
   If firstDay > 1 And counter = 1 Then

    For x = 1 To 8 - firstDay
   ws.Cells(iRow + 2 + i, firstDay + x - 1) = x
   Next x

   dt = 9 - firstDay
 'after placement of dates in the first-row for a month the counter value changes to 2, and then reverts 
  to 1 for the next month cycle:
  counter = 2
  w = 1
  End If

  'dates placement after the first row (for each month):
  ws.Cells(iRow + 2 + i + w, b) = dt
  dt = dt + 1

 End If

 Next b

 Next i
 w = 0

 'determine placement of day 1 for each month after the first month:
  firstDay = firstDay + mthDays Mod 7

 If firstDay > 7 Then
 firstDay = firstDay Mod 7
 Else
 firstDay = firstDay
  End If

 Next mth

 'formatting:
  iRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
  ws.Range("A" & iRow & ":G" & iRow).Borders(xlEdgeBottom).LineStyle = XlLineStyle.xlContinuous
  ws.Range("G1:G" & iRow).Borders(xlEdgeRight).LineStyle = XlLineStyle.xlContinuous

 With ws.Range("A1:G" & iRow)
 .Font.Name = "Arial"
  .Font.Size = 9
  .RowHeight = 12.75
  .HorizontalAlignment = xlCenter
  .ColumnWidth = 9


   End With

    End If

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
   Application.EnableEvents = True
  Application.DisplayStatusBar = True
  Application.Calculation = xlCalculationAutomatic






    ResetApplication:
     Err.Clear
     On Error GoTo 0
    Application.EnableEvents = True

   End Sub





  ' for floating holidays


       Public Sub floatingholidays(NDow As Date, Y As Integer, M As Integer, _
       N As Integer, DOW As Integer)

    NDow = DateSerial(Y, M, (8 - weekDay(DateSerial(Y, M, 1), _
     (DOW + 1) Mod 8)) + ((N - 1) * 7))

    End Sub





     'for Easter date determination


   Public Sub EasterDate(EasterDate2 As Date, Yr As Integer)
     Dim D As Integer
    D = (((255 - 11 * (Yr Mod 19)) - 21) Mod 30) + 21
      EasterDate2 = DateSerial(Yr, 3, 1) + D + (D > 48) + 6 - ((Yr + Yr \ 4 + _
        D + (D > 48) + 1) Mod 7)
  End Sub

Answer 1

You will not get a question like this answered here. You specify a large requirement and provide a large chunk of code that does not obviously relate to the requirement.

You must break this question into parts, attempt to solve those parts yourself.

For example:

Public Sub floatingholidays(NDow As Date, Y As Integer, M As Integer, _
   N As Integer, DOW As Integer)

NDow = DateSerial(Y, M, (8 - weekDay(DateSerial(Y, M, 1), _
 (DOW + 1) Mod 8)) + ((N - 1) * 7))

End Sub

Add some comments to this sub-routine explaining what it does. When you return to this routine in 12 months, will you remember how it works?

Does this sub-routine set NDow to the correct value? Test it using macros like this:

Sub TestFH()

  Call TestFHSub(2014, 1, 14, 5)
  Call TestFHSub(2013, 1, 10, 1)
  Call TestFHSub(2013, 2, 6, 2)
  Call TestFHSub(2013, 5, 7, 3)

End Sub
Sub TestFHSub(ByVal Y As Integer, ByVal M As Integer, ByVal N As Integer, ByVal DOW As Integer)

  Dim NDow As Date

  Call floatingholidays(NDow, Y, M, N, DOW)

  Debug.Print "If Y=" & Y & " M=" & M & " N=" & N & " DOW=" & DOW & "  Then NDow=" & NDow

End Sub

I doubt the values I used in my calls of TestFHSub are sensible. Replace them with a good selection of values so you are convinced this routine works as required. If you need help ask a question about floatingholidays.

Do the same EasterDate.

Next think about how to call routine. Placing this code in a Worksheet_Change routine means it will be called every time you switch worksheet.

Discard the On Error code which just makes debugging more difficult. Consider adding it at the end of development if there is a need. There probably will not be a need.

Discard Application.DisplayAlerts = False etc. Do not worry about the speed of the macro until you have got the code working.

MonthName is a VBA function so you do not need the monthName array.

WeekdayName is a VBA function so you do not need the weekDay array.

Build your macro a few statements at a time and check they are having the effect you seek. If small block of code does not give the effect you seek, ask a question about it.

Good luck.