Public SH As Worksheet, CalSH As Worksheet, PSH As Worksheet, IndexSH As Worksheet, NewSH As Worksheet

Function SortTheIndexColumn_Rearrange_Worksheets()
With IndexSH.Range("A5:A" & IndexSH.Range("A" & Rows.Count).End(xlUp).Row)
.HorizontalAlignment = xlLeft
End With
IndexSH.Sort.SortFields.Clear
IndexSH.Sort.SortFields.Add2 Key:=IndexSH.Range("A5"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With IndexSH.Sort
.SetRange IndexSH.Range("A5:A" & IndexSH.Range("A" & Rows.Count).End(xlUp).Row)
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Dim SheetDate As Date, FirstSh As Worksheet, SecondSh As Worksheet
For r = 5 To IndexSH.Range("A" & Rows.Count).End(xlUp).Row
SheetDate = IndexSH.Range("A" & r).Value
Y = Year(SheetDate)
M = MonthName(Month(SheetDate))
D = Day(SheetDate)
DayName = WeekdayName(Weekday(SheetDate))
Output = M & "_" & D & "_" & Y & "_" & DayName
If r = 5 Then
Set FirstSh = ThisWorkbook.Sheets("Calendar")
Else:
Set FirstSh = ThisWorkbook.Sheets(FirstSheetName)
End If
Set SecondSh = ThisWorkbook.Sheets(Output)
FirstSheetName = SecondSh.Name
SecondSh.Move after:=ThisWorkbook.Sheets(FirstSh.Name)
Next
End Function

Function FormatTheActiveSheetAndAddHyerLinkToDate()
DefineCalSH
Application.StatusBar = "Adding New Worksheet"
Y = Sheets("Personal_Data").Range("E9").Value
D = ActiveCell.Value
CellAddress = ActiveCell.Address
MName = ActiveCell.CurrentRegion.Cells(1, 1).Value
If MName = "January" Then
MonthNumber = 1
ElseIf MName = "February" Then
MonthNumber = 2
ElseIf MName = "March" Then
MonthNumber = 3
ElseIf MName = "April" Then
MonthNumber = 4
ElseIf MName = "May" Then
MonthNumber = 5
ElseIf MName = "June" Then
MonthNumber = 6
ElseIf MName = "July" Then
MonthNumber = 7
ElseIf MName = "August" Then
MonthNumber = 8
ElseIf MName = "September" Then
MonthNumber = 9
ElseIf MName = "October" Then
MonthNumber = 10
ElseIf MName = "November" Then
MonthNumber = 11
ElseIf MName = "December" Then
MonthNumber = 12
End If
ThisWorkbook.Sheets.Add after:=Worksheets("Calendar")
Set NewSH = ActiveSheet
DayName = WeekdayName(Weekday(DateSerial(Y, MonthNumber, D)))
ActiveSheet.Name = MName & "_" & D & "_" & Y & "_" & DayName
FunctionName = FormatNewWorhseet(MName, D, Y, MonthNumber)
CalSH.Range(CellAddress).Hyperlinks.Add _
anchor:=CalSH.Range(CellAddress), _
Address:="", _
SubAddress:=NewSH.Name & "!A1", _
ScreenTip:="Clik on Worksheet Link"
CalSH.Range(CellAddress).Interior.ColorIndex = 6
CalSH.Range(CellAddress).Font.Underline = xlUnderlineStyleNone
End Function

Function FormatNewWorhseet(MName, D, Y, MonthNumber)
ActiveSheet.Range("C2:O3").Merge
ActiveSheet.Range("C2").Value = Sheets("Personal_Data").Range("E6").Value & "'s Schedule as on " & MName & " " & D & ", " & Y
ActiveSheet.Range("C2").Select
FormatHeaderCell
maxcol = ActiveSheet.Range("Q1").End(xlToRight).Column
ActiveSheet.Range(Cells(1, 17), Cells(1, maxcol)).Select
Selection.Columns.Hidden = True
ActiveWindow.DisplayGridlines = False
ActiveSheet.Columns("O").ColumnWidth = 10.45
ActiveSheet.Range("N5:O5").Merge
ActiveSheet.Range("N5").Value = "Go To Calendar Sheet"
ActiveSheet.Range("N5").Hyperlinks.Add _
anchor:=ActiveSheet.Range("N5"), _
Address:="", _
SubAddress:=CalSH.Name & "!A1", _
ScreenTip:="Navigate to Calendar WorkSheet"
ActiveSheet.Range("N5").Font.Underline = xlUnderlineStyleNone
Set NewSH = ActiveSheet
DefineIndexWorksheet
IndexLastRow = IndexSH.Range("A" & Rows.Count).End(xlUp).Row + 1
Dim DateSH As Date
DateSH = DateSerial(Y, MonthNumber, D)
IndexSH.Cells(IndexLastRow, 1).Value = DateSH
IndexSH.Cells(IndexLastRow, 1).Hyperlinks.Add _
anchor:=IndexSH.Cells(IndexLastRow, 1), _
Address:="", _
SubAddress:=ThisWorkbook.ActiveSheet.Name & "!A1", _
ScreenTip:="Click here to view the worksheet"
CreateShapesButton
FormatTheColumn
SortTheIndexColumn_Rearrange_Worksheets
NewSH.Activate
End Function

Sub AddHyperLinks()
Application.StatusBar = "Refreshing Hyper Lins for Worksheets"
DefineIndexWorksheet
Dim i As Integer
LastRow = IndexSH.Range("A" & Rows.Count).End(xlUp).Row + 1
IndexSH.Range("A2:A" & LastRow).Clear
For i = 1 To ThisWorkbook.Sheets.Count
IndexSH.Cells(i + 1, 1).Value = ThisWorkbook.Sheets(i).Name
IndexSH.Cells(i + 1, 1).Hyperlinks.Add _
anchor:=IndexSH.Cells(i + 1, 1), _
Address:="", _
SubAddress:=ThisWorkbook.Sheets(i).Name & "!A1", _
ScreenTip:="Click here to view the worksheet"
Next
End Sub

Sub Delete_Sheets()
Application.DisplayAlerts = False
For Each SH In ThisWorkbook.Worksheets
If SH.Name <> "Personal_Data" And SH.Name <> "Index" And SH.Name <> "Calendar" Then
SH.Delete
End If
Next
LastRow = Sheets("Index").Range("A" & Rows.Count).End(xlUp).Row
Sheets("Index").Range("A5:A" & LastRow).Clear
Application.DisplayAlerts = True
End Sub

Function DefinePersonalDataSheet()
Set PSH = ThisWorkbook.Sheets("Personal_Data")
End Function

Function DefineIndexWorksheet()
Set IndexSH = ThisWorkbook.Sheets("Index")
End Function

Function DefineCalSH()
Set CalSH = ThisWorkbook.Sheets("Calendar")
End Function

Function Create_Calendar_PageHeader()
CalSH.Range("C2:W3").Merge
CalSH.Range("C2").Value = "Calendar For The Year Of " & PSH.Range("E9")
CalSH.Range("C2").Activate
FormatHeaderCell
End Function

Function FormatDateCell()
With ActiveCell
.Font.Size = 12
.Font.Name = "Calibri"
.Interior.ColorIndex = 15
.Font.ColorIndex = 1
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
End Function

Function FormatHeaderCell()
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
If ActiveCell.Row = 2 Then
.Font.Size = 20
Else:
.Font.Size = 15
End If
.Font.Name = "Calibri"
If ActiveCell.Address <> "$C$2" And ActiveCell.Interior.ColorIndex <> 9 Then
.Interior.ColorIndex = 10
End If
If ActiveCell.Address = "$C$2" Then
.Interior.ColorIndex = 25
End If
.Font.ColorIndex = 2
.Font.Bold = True
End With
End Function

Function FormatTheColumn()
With IndexSH.Range("A2:A" & IndexSH.Range("A" & Rows.Count).End(xlUp).Row)
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.Font.Size = 15
.Font.Name = "Calibri"
.Font.ColorIndex = 1
.Font.Bold = True
.Font.Underline = xlUnderlineStyleNone
End With
End Function

Function PrintDays()
rownum = ActiveCell.Row
columnNumb = ActiveCell.Column
Cells(rownum + 1, columnNumb).Value = "Sun"
Cells(rownum + 1, columnNumb + 1).Value = "Mon"
Cells(rownum + 1, columnNumb + 2).Value = "Tue"
Cells(rownum + 1, columnNumb + 3).Value = "Wed"
Cells(rownum + 1, columnNumb + 4).Value = "Thru"
Cells(rownum + 1, columnNumb + 5).Value = "Fri"
Cells(rownum + 1, columnNumb + 6).Value = "Sat"
Range(Cells(rownum + 1, columnNumb), Cells(rownum + 1, columnNumb + 6)).Select
FormatHeaderCell
End Function

Function DefineMonthCell(MName)
If MName = "January" Then
CalSH.Range("B5").Activate
ElseIf MName = "February" Then
CalSH.Range("J5").Activate
ElseIf MName = "March" Then
CalSH.Range("R5").Activate
ElseIf MName = "April" Then
CalSH.Range("B14").Activate
ElseIf MName = "May" Then
CalSH.Range("J14").Activate
ElseIf MName = "June" Then
CalSH.Range("R14").Activate
ElseIf MName = "July" Then
CalSH.Range("B23").Activate
ElseIf MName = "August" Then
CalSH.Range("J23").Activate
ElseIf MName = "September" Then
CalSH.Range("R23").Activate
ElseIf MName = "October" Then
CalSH.Range("B32").Activate
ElseIf MName = "November" Then
CalSH.Range("J32").Activate
ElseIf MName = "December" Then
CalSH.Range("R32").Activate
End If
Range(Cells(ActiveCell.Row, ActiveCell.Column), Cells(ActiveCell.Row, ActiveCell.Column + 6)).Merge
ActiveCell.Interior.ColorIndex = 9
End Function

Function ChangeTheColumnWidth()
CalSH.UsedRange.EntireColumn.ColumnWidth = 6
CalSH.Columns("A").ColumnWidth = 1
CalSH.Columns("I").ColumnWidth = 1
CalSH.Columns("Q").ColumnWidth = 1
CalSH.Columns("Y").ColumnWidth = 1
maxcol = CalSH.Range("Z1").End(xlToRight).Column
CalSH.Range(Cells(1, 26), Cells(1, maxcol)).Select
Selection.Columns.Hidden = True
CalSH.Rows("41:" & CalSH.Rows.Count).EntireRow.Hidden = True
End Function

Sub CreateCalendarDates()
Application.ScreenUpdating = False
DefineCalSH
CalSH.Activate
CalSH.UsedRange.Clear
DefinePersonalDataSheet
Create_Calendar_PageHeader
Dim YearNumber As Integer
YearNumber = PSH.Range("E9").Value
Dim M As Integer, MaxNumbOfDays As Integer
For M = 1 To 12
MName = MonthName(Month(DateSerial(YearNumber, M + 1, 0)), False)
DefineMonthCell (MName)
ActiveCell.Value = MonthName(Month(DateSerial(YearNumber, M + 1, 0)), False)
FormatHeaderCell
PrintDays
MonthNumber = M
MaxNumbOfDays = Day(DateSerial(YearNumber, M + 1, 0))
FirstDayWeek = Weekday(DateSerial(YearNumber, M, 1))
DayRow = ActiveCell.Offset(1, 0).Row
DayCol = ActiveCell.Column
ColNumb = DayCol
For DayNumber = 1 To MaxNumbOfDays
Cells(DayRow, DayCol + FirstDayWeek - 1).Activate
Cells(DayRow, DayCol + FirstDayWeek - 1).Value = DayNumber
FormatDateCell
DayCol = DayCol + 1
If DayCol + FirstDayWeek - 1 > ColNumb + 6 Then
DayCol = ColNumb
DayRow = DayRow + 1
FirstDayWeek = 1
End If
Next
Next
ChangeTheColumnWidth
AddHyperLinks
FormatTheColumn
Application.ScreenUpdating = True
Application.EnableEvents = True
MsgBox "Hi Completed"
End Sub

Function CreateShapesButton()
Dim Shap As Shape
With ActiveSheet.Range("N7:O7")
Set Shap = ActiveSheet.Shapes.AddShape(msoShapeRectangle, Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height)
End With
With Shap
.Name = "DeleteSheet"
.TextFrame.Characters.Text = "Delete Sheet"
.OnAction = "Delete_CurrentSheet"
.TextFrame.HorizontalAlignment = xlHAlignCenter
.TextFrame.VerticalAlignment = xlVAlignCenter
.TextFrame.Characters.Font.Size = 11
.TextFrame.Characters.Font.Name = "Calibri"
.TextFrame.Characters.Font.ColorIndex = 2
.TextFrame.Characters.Font.Bold = True
.Fill.ForeColor.RGB = RGB(0, 0, 226)
.Placement = xlFreeFloating
End With
End Function

Sub Delete_CurrentSheet()
Application.DisplayAlerts = False
Application.EnableEvents = False
SheetName = ActiveSheet.Name
Postsplit = Split(SheetName, "_")
MName = Postsplit(0)
D = Val(Postsplit(1))
Y = Val(Postsplit(2))
ActiveSheet.Delete
Set CalSH = ThisWorkbook.Sheets("Calendar")
CalSH.Activate
Dim SearchData As Range
Set SearchData = CalSH.UsedRange.Find(what:=MName, lookat:=xlWhole)
For r = 1 To SearchData.CurrentRegion.Rows.Count
For c = 1 To SearchData.CurrentRegion.Columns.Count
If SearchData.CurrentRegion.Cells(r, c).Value = D Then
SearchData.CurrentRegion.Cells(r, c).Activate
ActiveCell.Hyperlinks.Delete
FormatDateCell
End If
Next
Next
Set IndexSH = ThisWorkbook.Sheets("Index")
IndexSH.Activate
MNumber = Convert_Monthname_Into_MonthNumber(MName)
DateFormat = MNumber & "/" & D & "/" & Y
Set SearchData = IndexSH.UsedRange.Find(what:=DateFormat, lookat:=xlWhole)
SearchData.Select
SearchData.Clear
IndexSH.Columns(1).SpecialCells(xlCellTypeBlanks).Select
Selection.Delete Shift:=xlUp
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub

Function Convert_Monthname_Into_MonthNumber(MName)
If MName = "January" Then
MonthNumber = 1
ElseIf MName = "February" Then
MonthNumber = 2
ElseIf MName = "March" Then
MonthNumber = 3
ElseIf MName = "April" Then
MonthNumber = 4
ElseIf MName = "May" Then
MonthNumber = 5
ElseIf MName = "June" Then
MonthNumber = 6
ElseIf MName = "July" Then
MonthNumber = 7
ElseIf MName = "August" Then
MonthNumber = 8
ElseIf MName = "September" Then
MonthNumber = 9
ElseIf MName = "October" Then
MonthNumber = 10
ElseIf MName = "November" Then
MonthNumber = 11
ElseIf MName = "December" Then
MonthNumber = 12
End If
Convert_Monthname_Into_MonthNumber = MonthNumber
End Function