Macros for Dealing with Timesheet

Timesheet Worksheet Macros

Option Explicit
Sub CreatePayPeriod()
    Dim colStart, colLast, colIndex, colSum
    Dim colSumLetter, colLetter, colStartLetter, colLastLetter, colSecondWeekLetter
    Dim rowDate, rowSum, intWeekend, rowDay, rowHourStart, rowHourLast, rowAccum, rowLast
    Dim rowSecondWeekSum, rowSecondWeekAccum, secondWeek
    Dim dtStart, dtCurrent, dtLast
    Dim i
    Dim colRows As Collection

    dtStart = ConvertSheetNameToDate()
    dtCurrent = dtStart
    dtLast = GetLastDayOfPeriod(dtStart)

    colStartLetter = "C"
    colStart = ConvertLetterToNumber(colStartLetter)
    'OLD: colLast = GetPayPeriodLength(dtStart) - 1 + colStart
    colLast = 14 - 1 + colStart ' 2 weeks (14 days) pay period
    colLastLetter = ConvertNumberToLetter(colLast)
    colSum = colLast + 1
    colSumLetter = ConvertNumberToLetter(colSum)

    Set colRows = GetRowValues()
    rowDate = colRows.Item("Date")
    rowDay = colRows.Item("DayOfWeek")
    rowHourStart = colRows.Item("Hour1")
    rowHourLast = colRows.Item("HourX")
    rowSum = colRows.Item("Sum")
    rowAccum = colRows.Item("Accumulation")
    rowSecondWeekSum = colRows.Item("SecondWeekSum")
    rowSecondWeekAccum = colRows.Item("SecondWeekAccumulation")
    intWeekend = 0
    secondWeek = False

    For colIndex = colStart To colLast
        colLetter = ConvertNumberToLetter(colIndex)
        Cells(rowDate, colIndex).Formula = "=TEXT(""" & CStr(dtCurrent) & """,""MM/dd/yyyy"")"
        Cells(rowDay, colIndex).Formula = "=TEXT(" & colLetter & rowDate & ",""ddd"")"
        Range(colLetter & rowDate & ":" & colLetter & rowDate).Select
        HeaderFormat
        Range(colLetter & (rowDate + 1) & ":" & colLetter & rowAccum).Select
        If (IsWeekend(dtCurrent) = True) Then
            Range(colLetter & (rowDate + 1) & ":" & colLetter & rowAccum).Select
            WeekendFormat
            intWeekend = intWeekend + 1
        Else
            Cells(rowSum, colIndex).Formula = "=SUM(" & colLetter & (rowDate + 1) & _
                ":" & colLetter & (rowSum - 1) & ")"
            Cells(rowAccum, colIndex).Formula = "=SUM(" & colStartLetter & (rowDate + 1) & _
                ":" & colLetter & (rowSum - 1) & ")"
            WeekdayFormat
            Cells(rowAccum + 1, colIndex).Formula = "=IF(COUNTA(" & colLetter & (rowDate + 1) & _
                ":" & colLetter & (rowSum - 1) & ") <> 0,(COLUMNS(" & colStartLetter & ":" & colLetter & _
                ") - " & intWeekend & ") * 7.5,"""")"
        End If
        If secondWeek = True And IsWeekend(dtCurrent) = False Then
            Cells(rowSecondWeekAccum, colIndex).Formula = "=SUM(" & colSecondWeekLetter & (rowDate + 1) & _
                ":" & colLetter & (rowSum - 1) & ")"
            Cells(rowSecondWeekAccum + 1, colIndex).Formula = "=IF(COUNTA(" & colLetter & (rowDate + 1) & _
                ":" & colLetter & (rowSum - 1) & ") <> 0,(COLUMNS(" & colSecondWeekLetter & ":" & colLetter & _
                ") - " & (intWeekend - 2) & ") * 7.5,"""")"
            WeekdayFormat
        End If
        If DateDiff("d", dtCurrent, dtStart) = -7 Then ' Second Week
            secondWeek = True
            colSecondWeekLetter = colLetter
        End If
        BorderSelection
        dtCurrent = DateAdd("d", 1, dtCurrent)
    Next 'colIndex
    Cells(rowDate, colSum).Value = "Total"
    Range(colSumLetter & rowDate & ":" & colSumLetter & rowDate).Select
    HeaderFormat
    For i = (rowDate + 1) To rowSum
        Cells(i, colSum).Formula = "=SUM(" & colStartLetter & i & _
            ":" & colLastLetter & i & ")"
    Next 'i
    Range(colSumLetter & (rowDate + 1) & ":" & colSumLetter & rowSum).Select
    BorderSelection
    Range("A1:" & colSumLetter & (rowSum + 2)).Select
    Selection.Columns.AutoFit
    Cells(rowHourStart, colStart).Select

    MsgBox "Finished.", vbInformation, "CreatePayPeriod"
End Sub
Function ConvertLetterToNumber(ByVal Letter As String) As Integer
    Dim Letters()
    Letters = Array("", "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")

    ConvertLetterToNumber = GetArrayIndex(Letters, Letter)
End Function
Function ConvertNumberToLetter(ByVal Number As Integer) As String
    Dim Letters()
    Letters = Array("", "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")

    ConvertNumberToLetter = Letters(Number)
End Function
Function GetArrayIndex(ByRef arItems(), ByVal strItem) As Integer
    Dim arIndex

    For arIndex = LBound(arItems) To UBound(arItems)
        If StrComp(arItems(arIndex), strItem, vbTextCompare) = 0 Then
            GetArrayIndex = arIndex
            Exit Function
        End If
    Next 'arIndex
    GetArrayIndex = -1
End Function
Public Function IsWeekend(ByVal InputDate As Date) As Boolean
    Select Case Weekday(InputDate)
        Case vbSaturday, vbSunday
            IsWeekend = True
        Case Else
            IsWeekend = False
    End Select
End Function
Sub BorderSelection()
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
End Sub
Sub HeaderFormat()
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 12611584
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Selection.Font.Bold = True
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
End Sub
Sub WeekendFormat()
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 15773696
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End Sub
Sub WeekdayFormat()
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End Sub
Function ConvertSheetNameToDate()
    Dim shtName, dtSheet
    shtName = ActiveSheet.Name
    dtSheet = Mid(shtName, 5, 2) & "/" & Mid(shtName, 7, 2) & "/" & Mid(shtName, 1, 4)
    ConvertSheetNameToDate = dtSheet
End Function
Function GetFirstDayOfPeriod(ByVal intDay)
    If DatePart("d", intDay) <= 15 Then
        GetFirstDayOfPeriod = DateSerial(Year(intDay), Month(intDay), 1)
    Else
        GetFirstDayOfPeriod = DateSerial(Year(intDay), Month(intDay), 16)
    End If
End Function
Function GetLastDayOfPeriod(ByVal intDay)
    If DatePart("d", intDay) <= 15 Then
        GetLastDayOfPeriod = DateSerial(Year(intDay), Month(intDay), 15)
    Else
        GetLastDayOfPeriod = GetLastDayOfMonth(intDay)
    End If
End Function
Function GetPayPeriodLength(ByVal intDay)
    GetPayPeriodLength = DateDiff("d", GetFirstDayOfPeriod(intDay), GetLastDayOfPeriod(intDay)) + 1
End Function
Function GetLastDayOfMonth(ByVal intDay)
    GetLastDayOfMonth = DateSerial(Year(intDay), Month(intDay) + 1, 0)
End Function
Function IsPTO(ByVal txtDate) As Boolean
    Dim shtName, lastHRow, rowIndex
    Dim colDate

    shtName = "PTO"
    colDate = 1
    lastHRow = Sheets(shtName).Cells(Sheets(shtName).Rows.Count, colDate).End(xlUp).Row

    For rowIndex = 2 To lastHRow
        If DateValue(Sheets(shtName).Cells(rowIndex, colDate).Text) = DateValue(txtDate) Then
            IsPTO = True
            Exit Function
        End If
    Next rowIndex
    IsPTO = False
End Function
Function IsHoliday(ByVal txtDate, ByVal shtName) As Boolean
    Dim lastHRow, rowIndex
    Dim colDate

    colDate = ConvertLetterToNumber("A")
    lastHRow = Sheets(shtName).Cells(Sheets(shtName).Rows.Count, colDate).End(xlUp).Row

    For rowIndex = 2 To lastHRow
        If DateValue(Sheets(shtName).Cells(rowIndex, colDate).Text) = DateValue(txtDate) Then
            IsHoliday = True
            Exit Function
        End If
    Next rowIndex
    IsHoliday = False
End Function
Sub ColorCodeWeek()
    Dim colEnd, colEndLetter, colIndex, colStart
    Dim rowDate, rowDay, rowHour1, rowHour2, rowSum1, rowSum2, rowWorkHours
    Dim sDate
    Dim colRows As Collection

    colStart = ConvertLetterToNumber("C")
    
    Set colRows = GetRowValues()
    rowDate = colRows.Item("Date")
    rowDay = colRows.Item("DayOfWeek")
    rowHour1 = colRows.Item("Hour1")
    rowHour2 = colRows.Item("HourX")
    rowSum1 = colRows.Item("Sum")
    rowSum2 = colRows.Item("Accumulation")
    rowWorkHours = colRows.Item("WorkHours")
    
    colEnd = Cells(rowDate, Columns.Count).End(xlToLeft).Column
    colEndLetter = ConvertNumberToLetter(colEnd)

    For colIndex = colStart To colEnd
        sDate = Cells(rowDate, colIndex).Value
        If IsDate(sDate) Then
            Select Case Weekday(sDate, vbSunday)
                Case 1, 7 ' Sunday, Saturday
                    Range(Cells(rowDay, colIndex), Cells(rowSum2, colIndex)).Interior.ColorIndex = GetColorIndex("Light Blue")
                Case Else
                    If IsPTO(sDate) = True Then
                        Range(Cells(rowDay, colIndex), Cells(rowSum2, colIndex)).Interior.ColorIndex = GetColorIndex("Light Green")
                    ElseIf IsHoliday(sDate, "PenFed Holidays") = True Then
                        Range(Cells(rowDay, colIndex), Cells(rowSum2, colIndex)).Interior.ColorIndex = GetColorIndex("Light Orange")
                    Else
                        Range(Cells(rowDay, colIndex), Cells(rowSum2, colIndex)).Interior.ColorIndex = GetColorIndex("White")
                        If DateDiff("d", Now, Cells(rowDate, colIndex).Value) > 0 Then
                            Range(Cells(rowDay, colIndex), Cells(rowSum2, colIndex)).Interior.ColorIndex = GetColorIndex("Gray")
                        End If
                        Cells(rowSum1, colIndex).Formula = "=Sum($" & ConvertNumberToLetter(colIndex) & "$" & rowHour1 & _
                            ":$" & ConvertNumberToLetter(colIndex) & "$" & rowHour2 & ")"
                        Cells(rowSum2, colIndex).Formula = "=Sum($C$" & rowHour1 & ":$" & ConvertNumberToLetter(colIndex) & "$" & rowHour2 & ")"
                End If
            End Select
        End If
    Next colIndex
    Cells(1, 1).Select
    MsgBox "Done", vbOKOnly, "ColorCodeWeek"
End Sub
Sub UnhideAll()
    Dim sht As Worksheet

    For Each sht In Sheets
        With Sheets(sht.Name)
            .Activate
            .Visible = True
            .Columns.EntireColumn.Hidden = False
            .Rows.EntireRow.Hidden = False
            .Cells(1, 1).Select
        End With
    Next
End Sub
Sub HideTimeSheets(ByVal shtCurrent As String)
    Dim sht As Worksheet
    Dim arProtectedSheets()

    arProtectedSheets = Array("Federal Holidays", "HR Holidays", "HR SickDays", "PenFed Holidays", _
    "PTO", "Template", "Luach", "Compensation History", shtCurrent)

    For Each sht In Sheets
        If GetArrayIndex(arProtectedSheets, sht.Name) = -1 Then ' But Not Target
            ActiveWorkbook.Sheets(sht.Name).Visible = xlSheetHidden ' or xlSheetVeryHidden or xlSheetVisible
        End If
    Next
End Sub
Sub UnhideTimeSheet(ByVal shtCurrent As String)
    Dim sht As Worksheet

    Set sht = Sheets(shtCurrent)
    sht.Visible = xlSheetVisible
End Sub
Sub Run_HideSheets()
    Dim sht
    Dim currentShtName
    
    currentShtName = Sheets(1).Name
    
    For Each sht In Sheets
        If IsNumeric(sht.Name) Then
            If sht.Name > currentShtName Then
                currentShtName = sht.Name
            End If
        End If
    Next sht

    HideTimeSheets (currentShtName)
End Sub
Sub CreateSheetMap()
     Dim SheetName As String, sht As Worksheet, tWS As Worksheet
     Dim Total As Long, Count As Integer
     Dim Index As Integer, rowIndex As Integer

     SheetName = "Sheet Map"
     IfSheetExistsDelete SheetName

     Total = Sheets.Count
     ReDim arNames(Total)

     Count = 1
     For Each sht In Sheets
          On Error Resume Next
          arNames(Count) = sht.Name
          Count = Count + 1
     Next sht

     Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = SheetName
     Sheets(SheetName).Activate

     rowIndex = 1
     Sheets(SheetName).Cells(rowIndex, 1).Value = "Sheet Name(s)"
     Sheets(SheetName).Cells(rowIndex, 1).Font.Bold = True
     Sheets(SheetName).Cells(rowIndex, 2).Value = "Sheet Status"
     Sheets(SheetName).Cells(rowIndex, 2).Font.Bold = True

     For Index = LBound(arNames) To (UBound(arNames) - 1)
          rowIndex = Index + 2
          Sheets(SheetName).Cells(rowIndex, 1).Formula = _
               "=HYPERLINK(""#""&CELL(""Address"",'" & arNames(Index + 1) & _
                  "'!$A$1),""" & arNames(Index + 1) & """)"
          Sheets(SheetName).Cells(rowIndex, 2).Value = GetTextForVisibilityStatus(Worksheets(arNames(Index + 1)).Visible)
     Next Index
     Sheets(SheetName).Columns("A:B").EntireColumn.AutoFit

    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=INDIRECT(""B""&ROW())=""Visible"""
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 5287936
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    SelectAll_Format_LeftCenter_AllBorders
    Range("A1:B1").Select
    Selection.AutoFilter
    ActiveSheet.Range(ActiveCell, ActiveCell.SpecialCells(xlLastCell)).AutoFilter Field:=2, Criteria1:="Visible"
    Cells(1, 1).Select
    MsgBox "Done.", vbOKOnly, "CreateSheetMap"
End Sub
Sub IfSheetExistsDelete(ByVal SheetName As String)
     Dim tWS As Worksheet
     If SheetExists(SheetName) Then
          Set tWS = Sheets(SheetName)
          Application.DisplayAlerts = False
          tWS.Delete
          Application.DisplayAlerts = True
     End If
End Sub
Function SheetExists(ByVal SheetName As String) As Boolean
     Dim tWS As Worksheet
     On Error Resume Next
     Set tWS = Sheets(SheetName)
     If Not tWS Is Nothing Then
          SheetExists = True
     Else
          SheetExists = False
     End If
End Function
Function GetTextForVisibilityStatus(ByVal strStatus) As String
    Select Case strStatus
        Case xlSheetVisible
            GetTextForVisibilityStatus = "Visible"
        Case xlHidden
            GetTextForVisibilityStatus = "Hidden"
        Case xlVeryHidden
            GetTextForVisibilityStatus = "Very Hidden"
        Case Else
            GetTextForVisibilityStatus = ""
    End Select
End Function
Sub RenameSheets()
     Dim sht As Worksheet

     For Each sht In Sheets
          On Error Resume Next
          If InStr(sht.Name, "2015") = 1 Then
            sht.Name = "DISYS_" & sht.Name
          End If
     Next sht

     MsgBox "Done.", vbOKOnly, "RenameSheets"
End Sub
Sub CreateNextSheet()
    Dim sht As Worksheet
    Dim dtLast As Date, dtSheet As Date, dtNew As Date
    Dim strNew As String, shtTemplate As String

    shtTemplate = "Template"

    For Each sht In Sheets
        On Error Resume Next
        If InStr(1, sht.Name, "20", vbTextCompare) Then
            dtSheet = ConvertDateFormat(sht.Name, "yyyymmdd", "mm/dd/yyyy")
            If dtLast < dtSheet Then
                dtLast = dtSheet
            End If
        End If
    Next sht
    dtNew = DateAdd("d", 14, dtLast)
    strNew = Format(dtNew, "yyyymmdd")

    Worksheets(shtTemplate).Copy Before:=Worksheets(shtTemplate)
    ActiveSheet.Name = strNew
    CreatePayPeriod
    ColorCodeWeek
    HideTimeSheets strNew
    CreateSheetMap
    Sheets(strNew).Activate
    Sheets(strNew).Cells(1, 1).Activate
End Sub
Function ConvertDateFormat(ByVal strDate, ByVal strOldFormat, strNewFormat) As Date
    Dim dtDate As Date, fCheck As Boolean
    Dim iMon, iDay, iYear

    fCheck = True
    Select Case LCase(strOldFormat)
        Case "yyyymmdd"
            iYear = Left(strDate, 4)
            iDay = Right(strDate, 2)
            iMon = Mid(strDate, 5, 2)
        Case "mmddyyyy"
            iMon = Left(strDate, 2)
            iYear = Right(strDate, 4)
            iDay = Mid(strDate, 3, 2)
        Case "mm/dd/yyyy"
            iMon = Left(strDate, 2)
            iYear = Right(strDate, 4)
            iDay = Mid(strDate, 4, 2)
        Case Else
            dtDate = CDate(strDate)
            fCheck = False
    End Select
    If (fCheck) Then
        dtDate = DateSerial(iYear, iMon, iDay)
    End If
    ConvertDateFormat = Format(dtDate, strNewFormat)
End Function
Function GetColorIndex(ByVal strColor) As Integer
    Select Case strColor
        Case "Black"
            GetColorIndex = 1
        Case "Blue"
            GetColorIndex = 5
        Case "Brown"
            GetColorIndex = 53
        Case "Dark Blue"
            GetColorIndex = 11
        Case "Dark Green"
            GetColorIndex = 51
        Case "Dark Red"
            GetColorIndex = 9
        Case "Gray"
            GetColorIndex = 15
        Case "Green"
            GetColorIndex = 10
        Case "Light Blue"
            GetColorIndex = 33
        Case "Light Green"
            GetColorIndex = 35
        Case "Light Orange"
            GetColorIndex = 45
        Case "Light Purple"
            GetColorIndex = 39
        Case "Orange"
            GetColorIndex = 46
        Case "Dark Orange"
            GetColorIndex = 53
        Case "Pink"
            GetColorIndex = 7
        Case "Purple"
            GetColorIndex = 13
        Case "Red"
            GetColorIndex = 3
        Case "White"
            GetColorIndex = 2
        Case Else
            MsgBox "Unknown Color: " & strColor
    End Select
End Function
Sub ListColorIndexes()
    'John Walkenbach
    Dim Ndx As Long
    Sheets.Add
    For Ndx = 1 To 56
    Cells(Ndx, 1).Interior.ColorIndex = Ndx
    Cells(Ndx, 2).Value = Hex(ThisWorkbook.Colors(Ndx))
    Cells(Ndx, 3).Value = Ndx
    Next Ndx
End Sub
Sub SelectAll_Format_LeftCenter_AllBorders()
    ActiveCell.SpecialCells(xlLastCell).Select
    Range(Selection, Cells(1)).Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
End Sub
Sub GetCellInteriorColor()
    Dim iColor

    iColor = ActiveCell.Interior.ColorIndex
    MsgBox "Color: " & iColor
End Sub
Sub dSortWorksheets()

    Dim N As Integer
    Dim M As Integer
    Dim FirstWSToSort As Integer
    Dim LastWSToSort As Integer
    Dim SortDescending As Boolean
        
    If ActiveWindow.SelectedSheets.Count = 1 Then
        FirstWSToSort = 1
        LastWSToSort = Worksheets.Count
    Else
        With ActiveWindow.SelectedSheets
            For N = 2 To .Count
                If .Item(N - 1).Index <> .Item(N).Index - 1 Then
                    MsgBox "You cannot sort non-adjacent sheets"
                    Exit Sub
                End If
            Next N
            FirstWSToSort = .Item(1).Index
            LastWSToSort = .Item(.Count).Index
        End With
    End If

    For M = FirstWSToSort To LastWSToSort
        For N = M To LastWSToSort
            If (IsNumeric(Worksheets(N).Name) And IsNumeric(Worksheets(M).Name)) Then
                If (CLng(Worksheets(N).Name) > CLng(Worksheets(M).Name)) Then
                    Worksheets(N).Move Before:=Worksheets(M)
                End If
            ElseIf UCase(Worksheets(N).Name) < UCase(Worksheets(M).Name) Then
                Worksheets(N).Move Before:=Worksheets(M)
            End If
        Next N
    Next M
End Sub
Function GetRowValues() As Collection
    Dim sht As Worksheet
    Dim col As Collection
    Dim rowIndex As Integer, rowFirst As Integer, rowLast As Integer
    
    Set col = New Collection
    col.Add 1, "CurrentDate"
    col.Add 2, "Date"
    col.Add 3, "DayOfWeek"
    col.Add 4, "Hour1"
    
    Set sht = Sheets("Template")
    With sht
        rowFirst = 5
        rowLast = .Cells(.Rows.Count, 1).End(xlUp).Row

        For rowIndex = rowFirst To rowLast
            If InStr(1, Cells(rowIndex, 1).Value, "Sum", vbTextCompare) > 0 Then
                col.Add rowIndex, "Sum"
                col.Add (rowIndex - 1), "HourX"
                col.Add (rowIndex + 1), "Accumulation"
                col.Add (rowIndex + 2), "WorkHours"
                col.Add (rowIndex + 2), "SecondWeekSum"
                col.Add (rowIndex + 3), "SecondWeekAccumulation"

                Set GetRowValues = col
                Exit Function
            End If
        Next
    End With
    Set GetRowValues = Nothing
End Function