Consolidate used student hours into master sheet for export

Question

I've developed a spreadsheet that has evolved over several years to help keep track of the number of student contact hours that have been used to help flag up when students have run out / are running out of allocated hours (so that additional hour requests can be made if necessary).

There is a master workbook, which contains the VBA (below) and several worksheets. There is a "Master" worksheet, which is used for the consolidated view. This has columns for the students name, allocated hours, total hours used and then several columns with one for each month.

The workbook then has another worksheet for each tutor. The tutor worksheets are almost the same as the master sheet, however they have an additional column which is the total number of hours used by that tutor.

The process flow is essentially each tutor works from an xlsx file that has a single sheet with their students on it. If they are allocated a new student during the month, they will add the student on to their spreadsheet and add hours as appropriate. At the end of the month, they email their sheet to the administrator who copies the contents of their sheet into their sheet on the master workbook. Once all of the sheets have been updated, the administrator runs the DSA_Total_Hours_Used macro, which consolidates the student information into the master sheet and then updates the individual tutor sheets and exports a new version of the individual tutors xlsx files that can be emailed back to them by the administrator.

The code itself does the several things:

• Clears the master sheets tracked hours (these will be repopulated during the processing)
• Sanity checks the Allocated hours columns (it should be populated in the master for all students).
• Updates the TotalHours used column on the master to include a formula that sums the monthly totals
• For each student on any of the tutor sheets it attempts to match the students name with one of the students on the master sheet. If the student can't be found, it highlights the student in red and raises a warning. Fuzzy matching is used for matching the student name, essentially the matching removes ", -" and tries reversing the first and last name.
• Each matched student then has their AllocatedHours compared between the master and the tutor sheet to ensure the number is the same, flagging up a warning if they aren't.
• The hours from the matched students are also copied into the corresponding cells on the master sheet (student/month) and added to any existing value.
• Formula are generated on the tutor sheets so to calculated the total number of hours used for students (taking into account hours used by other tutors).
• Conditional formatting formulas are added to all sheets to highlight when students are approaching their allocated hours limits.
• Individual tutor sheets are then exported as xlsx files.
• The entire workbook is exported as an xlsx file (the mail system doesn't like xlsm files).

I really just use VBA to get things to work, so some of what I've done feels quite clunky and I'm not sure if that's just the way it is, of if I'm doing things the hard way, so any feedback is welcome.

Const StudentNameColumn = 1
Const AllocatedHoursColumn = 2
Const TotalHoursUsedColumn = 3
Const HoursUsedByTutorColumn = 4
Const HoursUsedByThisTutorColumn = 5
Const FirstPayCutoffColumn = 6
Const LastPayCutoffColumn = FirstPayCutoffColumn + 11
Const SumsRow = 1
Const HeadingsRow = 2
Const MinStudentRowTutorSheet = 3
Const MaxStudentRowTutorSheet = 100
Const MinStudentRowMasterSheet = 3
Const MaxStudentRowMasterSheet = 300

Private NameMissingFromMaster As Boolean
Private MasterSheet As Object

Sub DSA_Total_Hours_Used()
    NameMissingFromMaster = False
    Set MasterSheet = Sheets("Master")

    ValidateAllocatedHoursPresent
    ValidateAllocatedHoursMatch
    UpdateMasterTotalHoursUsedFormula

    ' Clear the hours per month from the master sheet
    BlankMasterSheet

    'Populate the hours per month from tutor sheets into master
    For Each sheet In Sheets
        If (sheet.Name <> "Master") Then
            ExtractTutorsHours sheet
        End If
    Next

    'Update total hours and formula from master into tutor sheets
    UpdateTutorSpreadSheets

    SetupConditionalFormatting

    If (NameMissingFromMaster) Then
        MsgBox ("At least one student on tutor spreadsheet not matched on master." & vbNewLine & "Please review and add new students to Master / correct any typos.")
    Else
       ' Export sheets?
       exportTutorSheets = MsgBox("Updates processed successfully.  Export tutor sheets?", vbYesNo, "Processing Complete")

       ' Check pressed button
       If exportTutorSheets = vbNo Then
           MsgBox "Tutor sheets not exported."
       Else
           SaveSheetsAsNewBook
           MsgBox "Export complete, don't forget to e-mail them to the tutors :)"
       End If
    End If
End Sub

Private Sub ValidateAllocatedHoursPresent()
    For Row = MinStudentRowMasterSheet To MaxStudentRowMasterSheet Step 1
        If (MasterSheet.Cells(Row, StudentNameColumn).Value2 <> Empty) Then
            If (MasterSheet.Cells(Row, AllocatedHoursColumn).Value2 = Empty) Then
                proceed = MsgBox("Student " & MasterSheet.Cells(Row, StudentNameColumn).Value2 & " is missing allocated hour information" & vbNewLine _
                                  & "Proceed?", vbYesNo, "Missing Allocated Hours")
                If proceed = vbNo Then
                    MsgBox "Run aborted"
                    End
                Else
                    Exit For
                End If
            End If
        End If
    Next
End Sub

Private Sub UpdateMasterTotalHoursUsedFormula()
    For Row = MinStudentRowMasterSheet To MaxStudentRowMasterSheet Step 1
        If (MasterSheet.Cells(Row, StudentNameColumn).Value2 <> Empty) Then
            MasterSheet.Cells(Row, TotalHoursUsedColumn).Value2 = "=SUM(" & Range(MasterSheet.Cells(Row, FirstPayCutoffColumn), MasterSheet.Cells(Row, LastPayCutoffColumn)).Address(False, False) & ")"
        End If
    Next
End Sub

Private Sub ValidateAllocatedHoursMatch()
    hoursMismatch = False
    For Each sheet In Sheets
        If (sheet.Name <> "Master") Then
            Set tutorSheet = sheet
            For Row = MinStudentRowTutorSheet To MaxStudentRowTutorSheet Step 1
                If (tutorSheet.Cells(Row, StudentNameColumn).Value2 <> Empty) Then
                    studentName = tutorSheet.Cells(Row, StudentNameColumn).Value2
                    masterRow = LocateStudent(MasterSheet, studentName)
                    If (masterRow > 0) Then
                        If (MasterSheet.Cells(masterRow, AllocatedHoursColumn) <> tutorSheet.Cells(Row, AllocatedHoursColumn)) Then
                            hoursMismatch = True
                            MasterSheet.Cells(masterRow, AllocatedHoursColumn).Font.Color = vbRed
                            tutorSheet.Cells(Row, AllocatedHoursColumn).Font.Color = vbRed
                        End If
                    End If
                End If
            Next
        End If
    Next

    If (hoursMismatch) Then
        If (MsgBox("At least one student's allocated hours do not match.  Proceed?", vbYesNo, "Allocated hours mismatch") = vbNo) Then
            End
        End If
    End If

End Sub


Private Sub UpdateTutorSpreadSheets()
    For Each sheet In Sheets
        If (sheet.Name <> "Master") Then
            ExtractHoursUsedIntoTutorsSheet sheet
            ClearDataFormatOnTutorSheet sheet
            SetMonthlySumFormulas sheet
        End If
    Next
End Sub

Private Sub ClearDataFormatOnTutorSheet(tutorSheet)
    Range(tutorSheet.Cells(MinStudentRowTutorSheet, AllocatedHoursColumn), tutorSheet.Cells(MaxStudentRowTutorSheet, LastPayCutoffColumn)).NumberFormat = "General"
End Sub

Private Sub SetMonthlySumFormulas(tutorSheet)
    For col = FirstPayCutoffColumn To LastPayCutoffColumn Step 1
        tutorSheet.Cells(SumsRow, col).Formula = "=SUM(" & Range(tutorSheet.Cells(MinStudentRowTutorSheet, col), tutorSheet.Cells(MaxStudentRowTutorSheet, col)).Address(False, False) & ")"
    Next
End Sub

Sub ExtractHoursUsedIntoTutorsSheet(tutorSheet)
    For Row = MinStudentRowTutorSheet To MaxStudentRowTutorSheet Step 1
        If (tutorSheet.Cells(Row, StudentNameColumn).Value2 <> Empty) Then
            studentName = tutorSheet.Cells(Row, StudentNameColumn).Value2
            masterRow = LocateStudent(MasterSheet, studentName)
            If (masterRow > 0) Then

                used = Application.Sum(Range(tutorSheet.Cells(Row, FirstPayCutoffColumn), tutorSheet.Cells(Row, LastPayCutoffColumn)))

                tutorSheet.Cells(Row, AllocatedHoursColumn).Value2 = MasterSheet.Cells(masterRow, AllocatedHoursColumn).Value2

                tutorSheet.Cells(Row, TotalHoursUsedColumn).Formula = "=" & MasterSheet.Cells(masterRow, TotalHoursUsedColumn).Value2 & " - " & used & " + Sum(" & Range(tutorSheet.Cells(Row, FirstPayCutoffColumn), tutorSheet.Cells(Row, LastPayCutoffColumn)).Address(False, False) & ")"

                tutorSheet.Cells(Row, HoursUsedByTutorColumn).Formula = "=SUM(" & Range(tutorSheet.Cells(Row, FirstPayCutoffColumn), tutorSheet.Cells(Row, LastPayCutoffColumn)).Address(False, False) & ")"

            End If
        End If
    Next

    tutorSheet.Cells(HeadingsRow, HoursUsedByThisTutorColumn).Value2 = "Pay Cut Off"
    tutorSheet.Cells(HeadingsRow, HoursUsedByTutorColumn).Value2 = "Hours Used By " & tutorSheet.Name

    For Column = FirstPayCutoffColumn To LastPayCutoffColumn Step 1
        tutorSheet.Cells(HeadingsRow, Column).Value2 = MasterSheet.Cells(HeadingsRow, Column).Value2
    Next

End Sub


Sub SaveSheetsAsNewBook()
    docPath = ActiveWorkbook.Path
    masterName = ActiveWorkbook.FullName
    currentDate = Date
    currentDate = Replace(currentDate, "/", "-")
    For Each sheet In Sheets
        If (sheet.Name <> "Master") Then
            sheet.Select
            sheet.Copy
            ActiveWorkbook.SaveAs Filename:=docPath + "\DSA_Tracker " + sheet.Name + " " + currentDate + ".xlsx", _
                FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
            ActiveWindow.Close
        End If
    Next

    CopyWorkbook docPath, currentDate

End Sub

Sub CopyWorkbook(docPath, currentDate)
    master = ActiveWorkbook.Name

    Dim sh As Worksheet, wb As Workbook
    Set newBook = Workbooks.Add
        With newBook
            .Title = "DSA Tracker"
            .Subject = "Static DSA Tracker"
            .SaveAs Filename:=docPath + "\DSA_Tracker Admin " + currentDate + ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        End With

    For Each sh In Workbooks(master).Worksheets
        sh.Copy After:=newBook.Sheets(newBook.Sheets.Count)
    Next sh

    newBook.Save
    newBook.Close

End Sub


Private Sub ExtractTutorsHours(tutorSheet)
    tutorSheet.Cells.Font.Bold = False
    tutorSheet.Cells.Font.Color = vbBlack

    For Row = MinStudentRowTutorSheet To MaxStudentRowTutorSheet Step 1
        If (tutorSheet.Cells(Row, StudentNameColumn).Value2 <> Empty) Then
            studentName = tutorSheet.Cells(Row, StudentNameColumn).Value2
            masterRow = LocateStudent(MasterSheet, studentName)
            If (masterRow > 0) Then
                For Column = FirstPayCutoffColumn To LastPayCutoffColumn Step 1
                    If (tutorSheet.Cells(Row, Column).Value2 <> Empty And Trim(tutorSheet.Cells(Row, Column).Value2) <> Empty) Then
                        If (MasterSheet.Cells(masterRow, Column).Value2 = Empty) Then
                            MasterSheet.Cells(masterRow, Column).Value2 = 0
                        End If
                        MasterSheet.Cells(masterRow, Column).Value2 = MasterSheet.Cells(masterRow, Column).Value2 + tutorSheet.Cells(Row, Column)
                    End If
                Next
            Else
                NameMissingFromMaster = True

                tutorSheet.Cells(Row, StudentNameColumn).EntireRow.Font.Color = vbRed
                tutorSheet.Cells(Row, StudentNameColumn).EntireRow.Font.Bold = True
            End If
        End If

    Next
End Sub

Function LocateStudent(sheet, studentName) As Integer
    For Row = MinStudentRowMasterSheet To MaxStudentRowMasterSheet Step 1
        If (Matches(sheet.Cells(Row, StudentNameColumn).Value2, studentName)) Then
            LocateStudent = Row
            Exit Function
        End If
    Next
    LocateStudent = 0
End Function

Function Matches(masterValue, subValue) As Boolean
    simpleMaster = Reduce(masterValue)
    simpleCompare = Reduce(subValue)
    Matches = (simpleMaster = simpleCompare)
    If (Not Matches) Then
        simpleCompare = Reduce(ReverseName(subValue))
        Matches = (simpleMaster = simpleCompare)
        If (Not Match) Then
            simpleCompare = Reduce(subValue)
            simpleMaster = Reduce(ReverseName(masterValue))
        End If
    End If
End Function

Function ReverseName(source) As String
    firstSpace = InStr(source, " ")
    If (firstSpace = Null Or firstSpace = 0) Then
        ReverseName = source
        Exit Function
    End If
    lastWord = Mid(source, firstSpace)
    firstWord = Mid(source, 1, firstSpace)
    ReverseName = lastWord & firstWord
End Function

Function Reduce(source) As String
    Reduce = Replace(Replace(Replace(LCase(source), " ", ""), ",", ""), "-", "")
End Function


Private Sub BlankMasterSheet()
    MasterSheet.Select
    Range(MasterSheet.Cells(MinStudentRowMasterSheet, HoursUsedByTutorColumn), ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.ClearContents
    MasterSheet.Cells.Font.Bold = False
    MasterSheet.Cells.Font.Color = vbBlack
    MasterSheet.Cells(MinStudentRowMasterSheet, HoursUsedByTutorColumn).Select
End Sub

Private Sub SetupConditionalFormatting()
    For Each sheet In Sheets
        If (sheet.Name <> "Master") Then
            Setupformatting sheet, MinStudentRowTutorSheet, MaxStudentRowTutorSheet
        Else
            Setupformatting sheet, MinStudentRowMasterSheet, MaxStudentRowMasterSheet
        End If
    Next
End Sub

Private Sub Setupformatting(sheet, firstRow, lastRow)
    sheet.Select
    sheet.Cells(firstRow, TotalHoursUsedColumn).Select
    With Range(sheet.Cells(firstRow, TotalHoursUsedColumn), sheet.Cells(lastRow, TotalHoursUsedColumn))
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
          "=IF(ISBLANK(" & sheet.Cells(firstRow, TotalHoursUsedColumn).Address(False, True) & "),FALSE," & _
          sheet.Cells(firstRow, AllocatedHoursColumn).Address(False, True) & " <= " & _
          sheet.Cells(firstRow, TotalHoursUsedColumn).Address(False, True) & ")"
        With .FormatConditions(.FormatConditions.Count)
            .SetFirstPriority
            With .Interior
                .PatternColorIndex = xlAutomatic
                .Color = vbRed
                .TintAndShade = 0
            End With
        End With
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
          "=IF(ISBLANK(" & _
          sheet.Cells(firstRow, TotalHoursUsedColumn).Address(False, True) & "),FALSE," & _
          sheet.Cells(firstRow, AllocatedHoursColumn).Address(False, True) & "<=(" & _
          sheet.Cells(firstRow, TotalHoursUsedColumn).Address(False, True) & "+(" & _
          sheet.Cells(firstRow, AllocatedHoursColumn).Address(False, True) & "/30 * 5)))"
        With .FormatConditions(.FormatConditions.Count)
            With .Interior
                .PatternColorIndex = xlAutomatic
                .Color = vbYellow
                .TintAndShade = 0
            End With
        End With
    End With
End Sub

Answer 1

I'm going to address your use of constants - I don't think they are helping you very much. Most of them are just constant numbers, yes, but when I go to any of your private subs - I have no idea what data to expect.

The same goes for the MasterSheet constant - it would make more sense to pass it to all of your subs ByVal masterSheet as Worksheet - it's the same as using the Set in the first sub and just passing it from there. Additionally - why is it an Object? It will always be a Worksheet.

I would also always turn on Option Explicit. You can have it automatically by going to Tools -> Options in the VBE and checking the Require Variable Declaration option. This way if you have any variables not defined, the compiler will let you know. Why would you want to know?

When you don't define your variable, VBA will declare it as a Variant, which are objects:

Performance. A variable you declare with the Object type is flexible enough to contain a reference to any object. However, when you invoke a method or property on such a variable, you always incur late binding (at run time). To force early binding (at compile time) and better performance, declare the variable with a specific class name, or cast it to the specific data type.

By not declaring variables, you could possibly be paying a penalty.

---

Additionally if possible, you should pass argument ByVal rather than ByRef. When you don't explicitly declare it, it defaults to ByRef.

---

This End isn't very elegant.

If proceed = vbNo Then
   MsgBox "Run aborted"
   End

My assumption is that the End should exit the entire process, so instead maybe call a garbage sub that cleans up and ends the main sub?

Private Sub ValidateAllocatedHoursPresent(ByVal masterSheet As Worksheet)
    Dim i As Long
    Dim proceed As Variant
    For i = 3 To 300 Step 1
        If Not IsEmpty(masterSheet.Cells(i, 1)) And IsEmpty(masterSheet.Cells(i, 2)) Then
            proceed = MsgBox("Student " & masterSheet.Cells(i, 1).Value2 & " is missing allocated hour information" & vbNewLine _
                        & "Proceed?", vbYesNo, "Missing Allocated Hours")
            If proceed = vbNo Then
                MsgBox "Run aborted"
                GoTo Garbage
                End
            Else
                Exit For
            End If
        End If
    Next
    Exit Sub
Garbage:
    'cleanup
End Sub

---

I tend to avoid variables that match keywords like sheet and row. I would modify this sub like this -

Private Sub UpdateMasterTotalHoursUsedFormula(ByVal masterSheet As Worksheet)
    Dim i As Long
    Dim myFormula As String
    For i = 3 To 300 Step 1
        If Not IsEmpty(masterSheet.Cells(i, 1)) Then
            myFormula = "=SUM(" & Range(masterSheet.Cells(i, 6), masterSheet.Cells(i, 17)).Address(False, False) & ")"
            masterSheet.Cells(i, 3).Formula = myFormula
        End If

    Next
End Sub

You'll see I used the VBA function IsEmpty and the Not so I didn't need to look for = FALSE. It's much cleaner this way, especially when using a boolean - there's no need to check its state, just use it (or Not).

I also constructed the formula in a string and used the .Formula property to set the formula, rather than what amounts to a VBA Indirect.

I would do the same on several of the other routines.

---

To eliminate the last constant I would do

Sub DSA_Total_Hours_Used()
    Dim NameMissingFromMaster As Boolean
    NameMissingFromMaster = False

Private Sub ExtractTutorsHours(ByVal tutorSheet As Worksheet, ByRef NameMissingFromMaster As Boolean)

Or better yet, I would extract a function to return the boolean instead of passing it ByRef

    If (sheet.Name <> "Master") Then
        NameMissingFromMaster = ExtractTutorsHours(sheet)
    End If

And

Private Function ExtractTutorsHours(ByVal tutorSheet As Worksheet) As Boolean
ExtractTutorsHours = False
'the rest of the function`

Answer 2

Couple of suggestions on what I think is a really well done job. I like the way you use subroutines, indents and with blocks

My first glance suggestions - will come back later and add more if I have time

Changes to declarations

' Specify Type of Constant
Const StudentNameColumn             As Integer = 1
Const AllocatedHoursColumn          As Integer = 2
Const TotalHoursUsedColumn          As Integer = 3
Const HoursUsedByTutorColumn        As Integer = 4
Const HoursUsedByThisTutorColumn    As Integer = 5
Const FirstPayCutoffColumn          As Integer = 6
Const LastPayCutoffColumn           As Integer = FirstPayCutoffColumn + 11
Const SumsRow                       As Integer = 1
Const HeadingsRow                   As Integer = 2
Const MinStudentRowTutorSheet       As Integer = 3
Const MaxStudentRowTutorSheet       As Integer = 100
Const MinStudentRowMasterSheet      As Integer = 3
Const MaxStudentRowMasterSheet      As Integer = 300

Private NameMissingFromMaster       As Boolean

' Change from generic Object
Private MasterSheet                 As Worksheet

Changes to your Setupformatting subroutine

Private Sub Setupformatting(sheet, firstRow, lastRow)
    ' Add two variable declarations
    Dim strAddrAllocHrs As String
    Dim strAddrTotalHrs As String

    ' Modify top of code to
    ' - use With Sheet
    ' - Remove select
    ' - store addresses
    With sheet
        .Select
        ' Remove This Line
        'sheet.Cells(firstRow, TotalHoursUsedColumn).Select

        ' Store two addresses in variables
        strAddrAllocHrs = .Cells(firstRow, AllocatedHoursColumn).Address(False, True)
        strAddrTotalHrs = .Cells(firstRow, TotalHoursUsedColumn).Address(False, True)
    End With

    ' Replace specific address references with pre determined variables
    With Range(sheet.Cells(firstRow, TotalHoursUsedColumn), sheet.Cells(lastRow, TotalHoursUsedColumn))
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
          "=IF(ISBLANK(" & strAddrTotalHrs & "),FALSE," & _
          strAddrAllocHrs & " <= " & _
          strAddrTotalHrs & ")"
        With .FormatConditions(.FormatConditions.Count)
            .SetFirstPriority
            With .Interior
                .PatternColorIndex = xlAutomatic
                .Color = vbRed
                .TintAndShade = 0
            End With
        End With
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
          "=IF(ISBLANK(" & _
          strAddrTotalHrs & "),FALSE," & _
          strAddrAllocHrs & "<=(" & _
          strAddrTotalHrs & "+(" & _
          strAddrAllocHrs & "/30 * 5)))"
        With .FormatConditions(.FormatConditions.Count)
            With .Interior
                .PatternColorIndex = xlAutomatic
                .Color = vbYellow
                .TintAndShade = 0
            End With
        End With
    End With
End Sub