Create new sheets copying and highlighting data from original

[joshlee]

Hello I am trying to work out a macro for this: I have a sheet 1 'Student Results Table' which includes name, incorrect response, Item ID and difficulty of question. I then have a second sheet named 'Tasks' which lists all possible Item ID's as well as associated tasks. I would like a macro to create new sheets based upon the student name, duplicate all data in the in the 'Tasks' sheet and highlight all Item ID's that correspond to an incorrect response for that student on sheet 1 'Student Results Table'. If I could get a column next to the highlighted Item ID's that also gives the Item difficulty that would be awesome.
Thank you!

 

[OaklandJim]

You show a lot of data. I'll need something to work with to help. Consider posting the data in a usable format. Do that with Mr. Excel's XL2BB addin which enables you to post portions of a worksheet. See more about the addin HERE. Better yet, post a copy of your workbook with realistic data using the link icon above the message area.

 

[OaklandJim]

Here are steps for macro from your description with questions.

Macro
1. creates new sheets based upon the student name. So one worksheet per student? All or some data from Student Results Table for each line item for a student is copied to the student-specific worksheets? If only SOME data is copied, which columns?

2. duplicate all data in the in the 'Tasks' sheet. Do you mean Curriculum Content Code? What else (you say all data in the Tasks sheet)?

3. highlight all Item ID's that correspond to an incorrect response for that student on 'Student Results Table' worksheet. Highlight the cell containing Item ID with yellow "fill" like highlighter pen if user responded incorrectly?

4. add a column next to the highlighted Item ID's that also gives the Item difficulty. That data is not transferred to the student-specific sheets when they are created?

This question is redundant but just the objective is clear to me: When complete what data columns are in the student-specific worksheets?

 

[joshlee]

Hello - thank you for responding! I have a copy for you to check out here

My end goal is for each student to have an individual sheet of their name (if that sheet could have their name in the top right cell that would be great also) that has all of the contents on the 'Task' sheet, then indicate which questions they got incorrect (by highlighting yellow) and then they will be able to use the links in column E to work on their areas of weakness.

To answer your questions in more detail:
1. From the 'Student results Table' sheet it will draw the name for the sheet (Column A 'student name'), if their answer was incorrect (Column D 'Student Marked Response') and then look at the Item ID (column B) and use that Item ID to highlight any duplicates on that individuals sheet. So basically searching for the questions they got wrong and highlighting them on the individuals sheet using the Item ID
2. Basically duplicate the 'Tasks' sheet with all of it's contents, and label the sheet the individuals name.
3. Yes highlight all the Item ID that correspond to a incorrect response by that student
4. I have accomplished this so don't worry about it

Thank you so much again!

 

[OaklandJim]

Regarding highlighting incorrect responses, the entire row or just the Item ID?

In all cases the links in Tasks are exactly the same. Is that what you want?

Textbooks :: Mathspace

mathspace.co

Or should the link for a specific row reflect the Curriculum Content Code for that same row (i.e., the one that corresponds to the Item ID in the same row). If so then most if not all CC Codes result in a content not found message to the user who follows a link like this LINK.

 

[joshlee]

Hi - I would be happy with just the Item ID being highlighted but the whole row would be great.

Yes I will go through and update the links after. Just wanted to see if it was possible to get the sheets created first. thank you!

 

[OaklandJim]

I have code to do everything that you asked for so far.

I have made all cells in rows with the incorrect response yellow.

If you are going to go through 10 - 20 rows with an incorrect response in 39 worksheets to "update links" that 'd be a lot of work. Maybe as many as 800 rows! Are you able to tell me what the links should be? Creating them with code is easy. As I said, right now each link is based on the CC Code.

Also, distributing the worksheets one at a time seems like it would be a lot of work. I could set code up to email a separate workbook containing the student-specific worksheet to each student using Outlook. If nothing else I think that you want separate student-specific workbooks containing the student-specific worksheet?

 

[joshlee]

Hi - my hope is to apply the macro to an updated set of results for the students, with updated links, when we receive the data in the coming weeks.

Emailing separate worksheets out would be cool - and yes if it could generate student specific workbooks that would be amazing.

Thank you for your help!

 

[OaklandJim]

The workbook that you asked for is HERE.

It processes all students by creating a worksheet for each then it creates a separate workbook for each containing the worksheet then it sends each workbook by email to the respective student. As usual, smarter list participants are likely to suggest better, more efficient ways to make this better. My code is a somewhat/very amateurish than code provided by list experts.

There are several settings in the code that you may want/need to change.

I hope that it works for you.

Option Explicit
Option Base 1

' ----------------------------------------------------------------
' Procedure Name: ProcessStudentData
' Purpose: Create student-specific worksheets and format Tasks and All Students' data worksheets.
' Procedure Kind: Sub
' Procedure Access: Public
' Author: Jim
' Date: 6/14/2023
' ----------------------------------------------------------------

Sub ProcessStudentData()

'   ----------------------
'       Error Handling
'   ----------------------
    Dim sSubName As String
    Dim sStepID As String

    sSubName = "Sub ProcessStudentData"
    sStepID = ""
    On Error GoTo ErrHandler
'   ----------------------

'   Worksheet containing all student's data.
    Dim wsStudents As Worksheet

'   Worksheet containing task's data.
    Dim wsTasks As Worksheet
    
'   Student-specific worksheet.
    Dim wsStudent As Worksheet

'   Array holding unique student names.
    Dim asStudentsList() As String

'   Student number (index) used when iterating through student-specific data.
    Dim iStudentIndex As Long

'   Data row for a student being processed when processing student-specific data.
    Dim iStudentDataRow As Long

'   Name of the student being processed.
    Dim sStudentName As String
    
'   Variable used to hold the Item ID.
    Dim sItemID As String
    
'   Variable used to hold the Curriculum Content Code for an Item ID.
    Dim sCCCode As String
    
'   Base part of URL to which CCCode is added for the full URL to content.
    Dim sBaseURL As String
    
'   The name of the worksheet containing all students' data.
    Dim sAllStudentsWorksheetName As String
    
'   The name of the worksheet containing Tasks data.
    Dim sTasksWorksheetName As String
    
'   Path to and name of student-specific file to save.
    Dim sPathAndFile As String

'   Data rows count and data row index used to iterate through data for all students.
    Dim iDataRowsCount As Long
    Dim iDataRowIndex As Long

'   Boolean var holding True or False indicatting whether Student's response is correct for an Item ID.
    Dim bIsIncorrect As Boolean
    
'   Flag indicating whether to send email to each student.
    Dim bDoEmail As Boolean
    
'   Flag indicating whether to delete worksheet after emailing it.
    Dim bDeleteWorksheetAfterEmail As Boolean
        
'   Email-related variables.
    Dim sEmailAddress As String
    Dim sEmailSubject As String
    Dim sEmailBody As String
    
'   --------------------------------
'       Various Initializations
'   --------------------------------
    
    sBaseURL = "https://mathspace.co/textbooks/syllabuses/Syllabus-1038/?selectTextbook=false&searchString="
    
    sEmailSubject = "Tasks worksheet" '<= need to specify the email subject line and body.
    sEmailBody = "Attached please find a worksheet with your tasks data."
 
 '  Dtermine whether user wants to send email after creating student-specific worksheets.
 '  Do that based on which button was used to call this sub.
    If Application.Caller = "ProcessNoEmail_Button" Then bDoEmail = False Else bDoEmail = True
    
'   Flag indicating whether to delete student-specific worksheet after it is emailed.
    bDeleteWorksheetAfterEmail = False '<= need to specify wheter to delete worksheet after email.

'    ---------------------------------------------------------------
'         Students Data Worksheet, Anchor Cell and Column Numbers
'   ---------------------------------------------------------------

    sStepID = "1. students' worksheet related setup"

'   Name of worksheet containing all students' data.
    sAllStudentsWorksheetName = "Student Results Table"  '<= Name of the all students' data worksheet.

'   Point wsStudents object to the worksheet with student data.
    Set wsStudents = ThisWorkbook.Worksheets(sAllStudentsWorksheetName)

'   Cell address for the anchor cell in the source data (i.e. all students' data). The cell will be the
'   data header labeled Student Name.
    Dim sAnchorStudentsAddress As String
    sAnchorStudentsAddress = "A1"  '<= cell address of the upperleftmost cell in the workksheet with all students.

'   Upperleftmost cell IN THE DATA in the students worksheet. This is a table header.
    Dim rAnchorStudentsData As Range
    
'   Point rAnchorStudentsData range object to the upperleftmost cell in
'   the student data. This cell will be the data header labeled Student Name.
    Set rAnchorStudentsData = wsStudents.Range(sAnchorStudentsAddress)

'   This is the column number for Item ID data header cell in the
'   the worksheet with all students' data. E.g. if Item Id data is in
'   column B then this value is 2.
    Dim iStudentsItemIDCol As Long
    iStudentsItemIDCol = FindLabelColumn(rAnchorStudentsData, "Item ID")

'   This is the column number for difficulty data header cell in the
'   the worksheet with all students' data. E.g. if difficulty data is in
'   column C then this value is 3.
    Dim iStudentsDifficultyCol As Long
    iStudentsDifficultyCol = FindLabelColumn(rAnchorStudentsData, "Difficulty", xlPart)

'   This is the column number for response (correct or incorrect value) data
'   header cell in the the worksheet with all students' data. E.g. if response
'   data is in column D then this value is 4.
    Dim iStudentsResponseCol As Long
    iStudentsResponseCol = FindLabelColumn(rAnchorStudentsData, "Response", xlPart)

'   -----------------------------------------------
'        Students Data Worksheet Freeze Panes
'   -----------------------------------------------

    wsStudents.Activate
    rAnchorStudentsData.Offset(1).EntireRow.Activate
    ActiveWindow.FreezePanes = True
    rAnchorStudentsData.Offset(1).Select

'   Add cell borders and alternating row shading using function BordersAndShading.
    Call BordersAndShading(rAnchorStudentsData)
    
'   -------------------------------------------------------------
'        Tasks Data Worksheet Anchor Cell and Column Numbers
'   -------------------------------------------------------------
    
    sStepID = "2. tasks worksheet related setup"
    
'   The name of the worksheet containing Tasks data.
    sTasksWorksheetName = "Tasks" '<= Name of the tasks data worksheet.
    
'   Point wsTasks object to the worksheet with tasks data.
    Set wsTasks = ThisWorkbook.Worksheets(sTasksWorksheetName)
    
'   Cell address for the anchor cell in the Tasks worksheet.
    Dim sAnchorCellTasksAddress As String
    sAnchorCellTasksAddress = "A1" '<= cell address of the upperleftmost cell in the student-specific workksheet.
    
'   Upperleftmost cell IN THE DATA in the tasks worksheet. This is a table header.
    Dim rAnchorCellTasks As Range
    Set rAnchorCellTasks = wsTasks.Range(sAnchorCellTasksAddress)
    
'   This is the column number for Item ID data header cell in the
'   the tasks worksheet data. E.g. if Item Id data is in column A
'   then this value is 1.
    Dim iTasksItemIDCol As Long
    iTasksItemIDCol = FindLabelColumn(rAnchorCellTasks, "Item ID")
    
'   This is the column number for CC Code data header cell in the
'   the tasks worksheet data. E.g. if CCCode data is in column C
'   then this value is 1.
    Dim iTasksCCCodeCol As Long
    iTasksCCCodeCol = FindLabelColumn(rAnchorCellTasks, "Code", xlPart)
    
'   This is the column number for Descriptor data header cell in the
'   the tasks worksheet data. E.g. if Descriptor data is in column D
'   then this value is 4.
    Dim iTasksDescriptorCol As Long
    iTasksDescriptorCol = FindLabelColumn(rAnchorCellTasks, "Descriptor")

'   This is the column number for "Task" links header cell in the
'   the tasks worksheet data. E.g. if Tasks links data is in column E
'   then this value is 5.
    Dim iTasksTaskLinkCol As Long
    iTasksTaskLinkCol = FindLabelColumn(rAnchorCellTasks, "Task")

'   ---------------------------------------------
'        Tasks Data Worksheet Freeze Panes
'   ---------------------------------------------

    wsTasks.Activate
    rAnchorCellTasks.Offset(1).EntireRow.Activate
    ActiveWindow.FreezePanes = True
    rAnchorCellTasks.Offset(1).Select

'   Add cell borders and alternating row shading using function BordersAndShading.
    Call BordersAndShading(rAnchorCellTasks)
    
'   ---------------------------------------------------------------
'       Student-specific Data Anchor Cells and Column Numbers
'   ---------------------------------------------------------------

    sStepID = "3. student-specific worksheet related setup"
    
'   Cell (object) in a student-specific worksheet containing the name.
    Dim rCellStudentName As Range
    
'   Address of cell in a student-specific worksheet containing the name.
    Dim sCellStudentNameAddress As String
    sCellStudentNameAddress = "A1"

'   Range that is the anchor cell in the student-specific data.
    Dim rAnchorStudentData As Range

'   Cell address for the anchor cell in the student-specific data.
    Dim sAnchorStudentDataAddress As String
    sAnchorStudentDataAddress = "A3" '<= cell address of the upperleftmost cell IN THE DATA
                                     '   in a student-specific worksheet.

'   This is the column number for Item ID data header cell in the
'   the student-specific worksheet data. E.g. if Item Id data is in
'   column A then this value is 1.
    Dim iStudentItemIDCol As Long
    iStudentItemIDCol = 1

'   This is the column number for difficulty data header cell in the
'   the student-specific worksheet data. E.g. if difficulty data is in
'   column B then this value is 2.
    Dim iStudentDifficultyCol As Long
    iStudentDifficultyCol = 2
    
'   This is the column number for CC Code data header cell in the
'   the student-specific worksheet data. E.g. if CC Code data is in
'   column C then this value is 3.
    Dim iStudentCCCodeCol As Long
    iStudentCCCodeCol = 3
    
'   This is the column number for Descriptor data header cell in the
'   the student-specific worksheet data. E.g. if Descriptor data is in
'   column D then this value is 4.
    Dim iStudentDescriptorCol As Long
    iStudentDescriptorCol = 4
    
'   This is the column number for Task Links header cell in the
'   the student-specific worksheet data. E.g. if Task Links are in
'   column E then this value is 5.
    Dim iStudentTaskLinkCol As Long
    iStudentTaskLinkCol = 5

'   Turn off screen updating and alerts regarding saving files, etc.
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With

'   -----------------------------------------------------------
'       Get Data Row Count and Load Array with Unique Names
'   -----------------------------------------------------------

    sStepID = "4. student data -- row count, unique names array"

'   Get count of rows containing student data in the "all students" data worksheet.
'   Used to iterate through all line items in the student's data.
    iDataRowsCount = rAnchorStudentsData.Cells(Rows.Count, 1).End(xlUp).Row - rAnchorStudentsData.Row
    
'   Load array with list of unique student names.
    Call LoadStudentArray(rAnchorStudentsData, asStudentsList())
    
'   ---------------------------------------------
'         Process All Unique Student Names
'   ---------------------------------------------

    sStepID = "5. processing all student's data"

'   Process each student.
    For iStudentIndex = 1 To UBound(asStudentsList())

'       Delete the student-specific worksheets if it already exists.
        On Error Resume Next
        ThisWorkbook.Worksheets(asStudentsList(iStudentIndex)).Delete
        On Error GoTo 0

'       Add the student-specific worksheet.
        Worksheets.Add(After:=Worksheets(Sheets.Count)).Name = asStudentsList(iStudentIndex)

'       Point the wsStudent worksheet object to the newly created worksheet.
        Set wsStudent = ThisWorkbook.Worksheets(asStudentsList(iStudentIndex))

'       Point rAnchorCellTargetData range object to the uppleftmost cell
'       in the data in student-specific worksheet. The cell address is in
'       var sAnchorCellTargetAddress.
        Set rAnchorStudentData = wsStudent.Range(sAnchorStudentDataAddress)

'       -----------------------------------------------
'              Process all Data for Each Student
'       -----------------------------------------------

        sStepID = "6. processing one student's data"

'       Put student name into cell specified by sCellStudentNameAddress then format.
        
        With wsStudent.Range(sCellStudentNameAddress)
            
            .Value = asStudentsList(iStudentIndex)
            
            With .Font
                .Bold = True
                .Size = 14
            End With
            
            .Offset(1).EntireRow.RowHeight = 5
            
        End With
        
        iStudentDataRow = 0
        
        For iDataRowIndex = 1 To iDataRowsCount

            sStepID = "6.a. getting student data"

'           If the data row iDataRowIndex for a student in the all students' data is not the
'           same as the student name being processed (which is in array asStudentsList) then
'           move to the next student.
            If rAnchorStudentsData.Offset(iDataRowIndex).Value = asStudentsList(iStudentIndex) _
             Then

'               Increment data row for student-specific data.
                iStudentDataRow = iStudentDataRow + 1
                
                sItemID = rAnchorStudentsData.Offset(iDataRowIndex, iStudentsItemIDCol - 1).Value

'               Put Item ID into student-specific data in student-specific worksheet.
                rAnchorStudentData.Offset(iStudentDataRow, iStudentItemIDCol - 1).Value = sItemID

'               Put difficulty into student-specific data in student-specific worksheet.
                  rAnchorStudentData.Offset(iStudentDataRow, iStudentDifficultyCol - 1).Value _
                = rAnchorStudentsData.Offset(iDataRowIndex, iStudentsDifficultyCol - 1).Value

'               Put CCCode into student-specific data in student-specific worksheet.
'               Lookup CCCode for Item ID using function LookupValueItemIDTasks.
                sCCCode = LookupValueItemIDTasks(sItemID, sAnchorCellTasksAddress, iTasksCCCodeCol)
                rAnchorStudentData.Offset(iStudentDataRow, iStudentCCCodeCol - 1).Value = sCCCode

'               Put Description into student-specific data in student-specific worksheet.
'               Lookup Description for Item ID using function LookupValueItemIDTasks.
                rAnchorStudentData.Offset(iStudentDataRow, iStudentDescriptorCol - 1).Value = _
                 LookupValueItemIDTasks(sItemID, sAnchorCellTasksAddress, iTasksDescriptorCol)

'               Put Task Link into student-specific data in student-specific worksheet.
                With wsStudent
                    .Hyperlinks.Add Anchor:=rAnchorStudentData.Offset(iStudentDataRow, iStudentTaskLinkCol - 1), _
                    Address:=sBaseURL & sCCCode, _
                    ScreenTip:="Get task information.", _
                    TextToDisplay:="Task"
                End With

'               Format the line item data being processed in student-specific worksheet.
                Call BordersAndShading(rAnchorStudentData, iDataRowIndex)

'               Check response = Incorrect
                bIsIncorrect = UCase(rAnchorStudentsData.Offset(iDataRowIndex, iStudentsResponseCol - 1).Value) = "INCORRECT"

'               If response is incorrect then highlight the cells in the data row.
                If bIsIncorrect _
                 Then

                    With rAnchorStudentData.Offset(iStudentDataRow).Resize(1, iStudentTaskLinkCol).Interior
                        .Pattern = xlSolid
                        .Color = 65535
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With

                End If

            End If

        Next iDataRowIndex

'       ---------------------------------------
'             Format Student-specific Data
'       ---------------------------------------

        sStepID = "6.b. formatting student data"

'       Put column header labels into the cells above the data. Format them too.
'       Do formatting by calling function FormatHeader.
        With rAnchorStudentData

            Call FormatHeader(.Cells(1), "Name")

            With .Offset(0, iStudentItemIDCol - 1)
                Call FormatHeader(.Cells(1), "Item ID")
            End With

            With .Offset(0, iStudentDifficultyCol - 1)
                Call FormatHeader(.Cells(1), "Difficulty")
            End With
            
            With .Offset(0, iStudentCCCodeCol - 1)
                Call FormatHeader(.Cells(1), "CC Code")
            End With
            
            With .Offset(0, iStudentDescriptorCol - 1)
                Call FormatHeader(.Cells(1), "Description")
            End With

            With .Offset(0, iStudentTaskLinkCol - 1)
                Call FormatHeader(.Cells(1), "Task")
            End With
                
        End With
        
'       -----------------------------------------------
'            Student Data Worksheet Freeze Panes
'       -----------------------------------------------

        rAnchorStudentData.Offset(1).EntireRow.Activate
        ActiveWindow.FreezePanes = True
        rAnchorStudentData.Offset(1).Select
        
'       -----------------------------------------
'             Save Student-specific Workbook
'       -----------------------------------------

        sStepID = "6.c. saving student data worksheet"

'       Path to and name of student-specific file to save.
        sPathAndFile = ThisWorkbook.Path & "\" & asStudentsList(iStudentIndex) & ".xlsx"
        
        Application.DisplayAlerts = False

        wsStudent.Move
        
        With ActiveWorkbook
            .SaveAs Filename:=sPathAndFile
            .Close
        End With
        
'       -----------------------------------------------
'             Send Email to Student with Workbook
'       -----------------------------------------------

        sStepID = "6.d. sending email to student"

'       If boolean flag bDoEmail is true then process email.
        If bDoEmail _
         Then

            sEmailAddress = LookupEmailAddress(asStudentsList(iStudentIndex))
            
            If sEmailAddress <> "" _
             Then
                Call SendEmail(sEmailAddress, sEmailSubject, sEmailBody, "") 'sPathAndFile
                
                If bDeleteWorksheetAfterEmail Then Kill sPathAndFile
            
            Else
                MsgBox "There is no email address for " & asStudentsList(iStudentIndex) & ".", vbInformation
            End If
        End If
'
        ThisWorkbook.Activate
        
    Next iStudentIndex
    
'   -------------------------------------------------------------------
'        "Done" Message then Activate All Students' Data Worksheet
'   -------------------------------------------------------------------

    MsgBox "Done processing " & UBound(asStudentsList) & " students."
    
    wsStudents.Activate
    
Exit Sub

ErrHandler:

Call ErrorMessage(Err.Number, Err.Description, sSubName, sStepID)
    
End Sub

Option Explicit

' ----------------------------------------------------------------
' Procedure Name: BordersAndShading
' Purpose: Add cell borders and row shading to a worksheet.
' Procedure Kind: Function
' Procedure Access: Public
' Parameter prAnchorcell (Range): Anchor cell for data.
' Author: Jim
' Date: 6/14/2023
' ----------------------------------------------------------------

Function BordersAndShading(prAnchorcell As Range, Optional piRow As Long = 0)
    
    Dim iRows As Long
    
    Dim iCols As Long
    
    Dim iRowOffset As Long
        
    With prAnchorcell
        
        If piRow <> 0 _
         Then
            iRows = 1
            iRowOffset = piRow
        Else
            iRows = .CurrentRegion.Rows.Count - 1
            iRowOffset = 1
        End If
        
        iCols = .CurrentRegion.Columns.Count
        
        With .Offset(iRowOffset).Resize(iRows, iCols)
        
'           -------------------------------
'                   Cell Borders
'           -------------------------------
        
            With .Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .Weight = xlThin
            End With

            With .Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .Weight = xlThin
            End With

            With .Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .Weight = xlThin
            End With

            With .Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .Weight = xlThin
            End With

            With .Borders(xlInsideVertical)
                .LineStyle = xlContinuous
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .Weight = xlThin
            End With

            With .Borders(xlInsideHorizontal)
                .LineStyle = xlContinuous
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .Weight = xlThin
            End With
            
'           -------------------------------
'                Alternate Row Shading
'           -------------------------------

            If piRow = 0 _
             Then

                .FormatConditions.Add Type:=xlExpression, Formula1:= _
                    "=MOD(ROW(),2)=1"
                
                .FormatConditions(.FormatConditions.Count).SetFirstPriority
                
                With .FormatConditions(1).Interior
                    .Pattern = xlGray16
                    .PatternThemeColor = xlThemeColorDark1
                    .ColorIndex = xlAutomatic
                    .PatternTintAndShade = -0.349986266670736
                End With
                
                .FormatConditions(1).StopIfTrue = False
            
            End If
        
        End With
     
    End With

End Function

Option Explicit

'Use to render the error messages from error handler.
Function ErrorMessage( _
    pErrNum As Integer, _
    psErrDescr, _
    Optional psSubName = "", _
    Optional psStepID = "")
    
'    If pErrNum = 18 Then Exit Function

    Dim sMsg As String
        
    Dim sTitle As String
    
    sTitle = "Error Message"
    
    sMsg = "Error #" & pErrNum & " occurred"
    
    If psSubName <> "" _
     Then sMsg = sMsg & Chr(10) & "in procedure " & psSubName
    
    sMsg = sMsg & "."
    
    If psStepID <> "" _
     Then sMsg = sMsg & Chr(10) & "Step ID: " & psStepID & "."
    
    sMsg = sMsg & Chr(10) & "Error Type: " & psErrDescr & "."
    
    MsgBox sMsg, vbOKOnly + vbCritical, sTitle
    
    Err.Clear
    
    Application.StatusBar = False
    DoEvents

End Function

Option Explicit

' ----------------------------------------------------------------
' Procedure Name: FindLabelColumn
' Purpose: Find the column # for the specified label in a worksheet's headers.
' Procedure Kind: Function
' Procedure Access: Public
' Parameter prAnchor (Range): Upperleftmost header cell.
' Parameter psValue (String): Value to find.
' Parameter piLookAt (Long): Look at 1) xlPart of word or 2) xlWhole word.
' Return Type: Long
' Author: Jim
' Date: 6/14/2023
' ----------------------------------------------------------------
Function FindLabelColumn(prAnchor As Range, psValue As String, Optional piLookAt As Long = xlWhole) As Long

    Dim rFoundCell As Range

    Set rFoundCell = prAnchor.EntireRow.Find( _
        What:=psValue, _
        LookIn:=xlFormulas, _
        LookAt:=piLookAt, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, _
        MatchCase:=False, _
        SearchFormat:=False)
    
    FindLabelColumn = rFoundCell.Column

End Function

Option Explicit

' ----------------------------------------------------------------
' Procedure Name: FormatHeader
' Purpose: Format header cells in student-specific worksheet.
' Procedure Kind: Function
' Procedure Access: Public
' Parameter prTarget (Range): The cell that is to be formatted and filled.
' Parameter psValue (String): The value that goes into the cell.
' Author: Jim
' Date: 6/8/2023
' ----------------------------------------------------------------

Function FormatHeader(prTarget As Range, psValue As String)

    With prTarget
        
'       Header value (label).
        .Value = psValue

'       Header white font.
        With .Font
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = 0
            .Bold = True
        End With
        
'       Alignment
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
     
'       Font bold, size 12
        .Font.FontStyle = "Bold"
        .Font.Size = 12
        
'       Add white thin borders
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .ThemeColor = 1
            .TintAndShade = 0
            .Weight = xlThin
        End With
        
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .ThemeColor = 1
            .TintAndShade = 0
            .Weight = xlThin
        End With
        
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ThemeColor = 1
            .TintAndShade = 0
            .Weight = xlThin
        End With
        
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .ThemeColor = 1
            .TintAndShade = 0
            .Weight = xlThin
        End With
        
'       Header gray fill.
        With .Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = -0.349986266670736
        End With
        
'       Autofit the column.
        .EntireColumn.AutoFit
    
    End With

End Function

Option Explicit
Option Base 1

' ----------------------------------------------------------------
' Procedure Name: LoadStudentArray
' Purpose: Load list of unique student names into ByRef array parameter.
' Procedure Kind: Function
' Procedure Access: Public
' Parameter prDataAnchor (Range): Upperleftmost cell that anchors all students' data.
' Parameter pasStudentList (String): ByRef array parameter holding unique student names.
' Return Type: String)
' Author: Jim
' Date: 6/8/2023
' ----------------------------------------------------------------

Function LoadStudentArray(ByVal prDataAnchor As Range, ByRef pasStudentList() As String)

    Dim iRowOffset As Long
    
    Dim iRowsCount As Long
    
    Dim sPreviousName As String
    
    Dim iNamesCount As Long
        
    iRowsCount = prDataAnchor.Cells(Rows.Count, 1).End(xlUp).Row - prDataAnchor.Row

    sPreviousName = ""
    
    For iRowOffset = 1 To iRowsCount
        
        If prDataAnchor.Offset(iRowOffset).Value <> sPreviousName _
         Then
            iNamesCount = iNamesCount + 1
            
            ReDim Preserve pasStudentList(iNamesCount)
            
            pasStudentList(iNamesCount) = prDataAnchor.Offset(iRowOffset).Value
            
            sPreviousName = prDataAnchor.Offset(iRowOffset).Value
        
        End If
    
    Next
    
End Function

Option Explicit

' ----------------------------------------------------------------
' Procedure Name: LookupValueItemIDTasks
' Purpose: Lookup value for the specified Item ID in the Tasks worksheet.
' Procedure Kind: Function
' Procedure Access: Public
' Parameter psItemID (String): Item ID to search for.
' Parameter psAnchorCellAddress (String): Address of anchor cell for data.
' Parameter piColNum (Long): Column number of data to return.
' Author: Jim
' Date: 6/14/2023
' ----------------------------------------------------------------

Function LookupValueItemIDTasks( _
 psItemID As String, _
 psAnchorCellAddress As String, _
 piColNum As Long)

    Dim wsTasks As Worksheet

    Dim iDataRows As Long

    Dim iDataRow As Long

    Dim rIDHeader As Range

    Dim rValueAnchor As Range

    Set wsTasks = ThisWorkbook.Worksheets("Tasks")

    Set rIDHeader = wsTasks.Range(psAnchorCellAddress)

    Set rValueAnchor = rIDHeader.Offset(0, piColNum - 1)

    iDataRows = rIDHeader.Cells(Rows.Count, 1).End(xlUp).Row - rIDHeader.Row

    For iDataRow = 1 To iDataRows

        If psItemID = rIDHeader.Offset(iDataRow) _
         Then

            LookupValueItemIDTasks = rValueAnchor.Offset(iDataRow)

            Exit Function

        End If

    Next

End Function

Option Explicit

' ----------------------------------------------------------------
' Procedure Name: LookupEmailAddress
' Purpose: Lookup email address for the specified person in Email worksheet.
' Procedure Kind: Function
' Procedure Access: Public
' Parameter psName (String): Name of person for which email address is sought.
' Author: Jim
' Date: 6/15/2023
' ----------------------------------------------------------------

Function LookupEmailAddress(psName As String)
        
    Dim rAnchorCell As Range
    
    Dim iName As Long
    
    LookupEmailAddress = "x"
    
    Set rAnchorCell = ThisWorkbook.Worksheets("Email").Range("A1")
        
    iName = 0
        
    With rAnchorCell
        Do
            iName = iName + 1

            If .Offset(iName).Value = psName _
             Then
                LookupEmailAddress = .Offset(iName, 1).Value
                Exit Function
            End If

        Loop Until .Offset(iName + 1).Value = ""
        
    End With

End Function

' ----------------------------------------------------------------
' Procedure Name: SendEmail
' Purpose: Send email to the specified address with specified attachment.
' Procedure Kind: Function
' Procedure Access: Public
' Parameter psEmailAddress (String): Email address to send email to.
' Parameter psEmailSubject (String): Email subject line content.
' Parameter sEmailBody (String): Email body content.
' Parameter psPathAndFile (String): Path and file name for the attachment.
' Parameter pbDoSend (Boolean): 1. Send email (True), 2. "display" email first (False).
' Author: Jim
' Date: 6/15/2023
' ----------------------------------------------------------------

Function SendEmail( _
    psEmailAddress As String, _
    psEmailSubject As String, _
    sEmailBody As String, _
    Optional psPathAndFile As String = "", _
    Optional pbDoSend As Boolean = True)
    
'   Objects used for sending email via outlook.
    Dim oOutlookApp As Object
    Dim oMailItem As Object
    
'   Set up Outlook objects for sending email.
    Set oOutlookApp = CreateObject("Outlook.Application")
    Set oMailItem = oOutlookApp.CreateItem(0)
    
'   Four scenarios
'   1. no attachment, do send
'   2. with attachment, do send
'   3. no attachment, do not send -- do display before sending
'   4. with attachment, do not send -- do display before sending
    
    If psPathAndFile = "" And pbDoSend _
     Then
'       Without attachment
        With oMailItem
            .To = psEmailAddress  'Specify the email address of the recipient
            .Subject = psEmailSubject
            .Body = sEmailBody
            .Send
        End With
     
     ElseIf psPathAndFile <> "" And pbDoSend _
      Then
        With oMailItem
            .To = psEmailAddress  'Specify the email address of the recipient
            .Subject = psEmailSubject
            .Body = sEmailBody
            .Attachments.Add psPathAndFile
            .Send
        End With
         
    If psPathAndFile = "" And Not pbDoSend _
     Then
'       Without attachment
        With oMailItem
            .To = psEmailAddress  'Specify the email address of the recipient
            .Subject = psEmailSubject
            .Body = sEmailBody
            .Display
        End With
         
    Else 'psPathAndFile <> "" And Not pbDoSend
    
        With oMailItem
            .To = psEmailAddress  'Specify the email address of the recipient
            .Subject = psEmailSubject
            .Body = sEmailBody
            .Attachments.Add psPathAndFile
            .Display
        End With
    
    End If

End Function

Option Explicit
Option Base 1

' ----------------------------------------------------------------
' Procedure Name: ProcessStudentData
' Purpose: Create student-specific worksheets and format Tasks and All Students' data worksheets.
' Procedure Kind: Sub
' Procedure Access: Public
' Author: Jim
' Date: 6/14/2023
' ----------------------------------------------------------------

Sub ProcessStudentData()

'   ----------------------
'       Error Handling
'   ----------------------
    Dim sSubName As String
    Dim sStepID As String

    sSubName = "Sub ProcessStudentData"
    sStepID = ""
    On Error GoTo ErrHandler
'   ----------------------

'   Worksheet containing all student's data.
    Dim wsStudents As Worksheet

'   Worksheet containing task's data.
    Dim wsTasks As Worksheet
    
'   Student-specific worksheet.
    Dim wsStudent As Worksheet

'   Array holding unique student names.
    Dim asStudentsList() As String

'   Student number (index) used when iterating through student-specific data.
    Dim iStudentIndex As Long

'   Data row for a student being processed when processing student-specific data.
    Dim iStudentDataRow As Long

'   Name of the student being processed.
    Dim sStudentName As String
    
'   Variable used to hold the Item ID.
    Dim sItemID As String
    
'   Variable used to hold the Curriculum Content Code for an Item ID.
    Dim sCCCode As String
    
'   Base part of URL to which CCCode is added for the full URL to content.
    Dim sBaseURL As String
    
'   The name of the worksheet containing all students' data.
    Dim sAllStudentsWorksheetName As String
    
'   The name of the worksheet containing Tasks data.
    Dim sTasksWorksheetName As String
    
'   Path to and name of student-specific file to save.
    Dim sPathAndFile As String

'   Data rows count and data row index used to iterate through data for all students.
    Dim iDataRowsCount As Long
    Dim iDataRowIndex As Long

'   Boolean var holding True or False indicatting whether Student's response is correct for an Item ID.
    Dim bIsIncorrect As Boolean
    
'   Flag indicating whether to send email to each student.
    Dim bDoEmail As Boolean
    
'   Flag indicating whether to delete worksheet after emailing it.
    Dim bDeleteWorksheetAfterEmail As Boolean
        
'   Email-related variables.
    Dim sEmailAddress As String
    Dim sEmailSubject As String
    Dim sEmailBody As String
    
'   --------------------------------
'       Various Initializations
'   --------------------------------
    
    sBaseURL = "https://mathspace.co/textbooks/syllabuses/Syllabus-1038/?selectTextbook=false&searchString="
    
    sEmailSubject = "Tasks worksheet" '<= need to specify the email subject line and body.
    sEmailBody = "Attached please find a worksheet with your tasks data."
 
 '  Dtermine whether user wants to send email after creating student-specific worksheets.
 '  Do that based on which button was used to call this sub.
    If Application.Caller = "ProcessNoEmail_Button" Then bDoEmail = False Else bDoEmail = True
    
'   Flag indicating whether to delete student-specific worksheet after it is emailed.
    bDeleteWorksheetAfterEmail = False '<= need to specify wheter to delete worksheet after email.

'    ---------------------------------------------------------------
'         Students Data Worksheet, Anchor Cell and Column Numbers
'   ---------------------------------------------------------------

    sStepID = "1. students' worksheet related setup"

'   Name of worksheet containing all students' data.
    sAllStudentsWorksheetName = "Student Results Table"  '<= Name of the all students' data worksheet.

'   Point wsStudents object to the worksheet with student data.
    Set wsStudents = ThisWorkbook.Worksheets(sAllStudentsWorksheetName)

'   Cell address for the anchor cell in the source data (i.e. all students' data). The cell will be the
'   data header labeled Student Name.
    Dim sAnchorStudentsAddress As String
    sAnchorStudentsAddress = "A1"  '<= cell address of the upperleftmost cell in the workksheet with all students.

'   Upperleftmost cell IN THE DATA in the students worksheet. This is a table header.
    Dim rAnchorStudentsData As Range
    
'   Point rAnchorStudentsData range object to the upperleftmost cell in
'   the student data. This cell will be the data header labeled Student Name.
    Set rAnchorStudentsData = wsStudents.Range(sAnchorStudentsAddress)

'   This is the column number for Item ID data header cell in the
'   the worksheet with all students' data. E.g. if Item Id data is in
'   column B then this value is 2.
    Dim iStudentsItemIDCol As Long
    iStudentsItemIDCol = FindLabelColumn(rAnchorStudentsData, "Item ID")

'   This is the column number for difficulty data header cell in the
'   the worksheet with all students' data. E.g. if difficulty data is in
'   column C then this value is 3.
    Dim iStudentsDifficultyCol As Long
    iStudentsDifficultyCol = FindLabelColumn(rAnchorStudentsData, "Difficulty", xlPart)

'   This is the column number for response (correct or incorrect value) data
'   header cell in the the worksheet with all students' data. E.g. if response
'   data is in column D then this value is 4.
    Dim iStudentsResponseCol As Long
    iStudentsResponseCol = FindLabelColumn(rAnchorStudentsData, "Response", xlPart)

'   -----------------------------------------------
'        Students Data Worksheet Freeze Panes
'   -----------------------------------------------

    wsStudents.Activate
    rAnchorStudentsData.Offset(1).EntireRow.Activate
    ActiveWindow.FreezePanes = True
    rAnchorStudentsData.Offset(1).Select

'   Add cell borders and alternating row shading using function BordersAndShading.
    Call BordersAndShading(rAnchorStudentsData)
    
'   -------------------------------------------------------------
'        Tasks Data Worksheet Anchor Cell and Column Numbers
'   -------------------------------------------------------------
    
    sStepID = "2. tasks worksheet related setup"
    
'   The name of the worksheet containing Tasks data.
    sTasksWorksheetName = "Tasks" '<= Name of the tasks data worksheet.
    
'   Point wsTasks object to the worksheet with tasks data.
    Set wsTasks = ThisWorkbook.Worksheets(sTasksWorksheetName)
    
'   Cell address for the anchor cell in the Tasks worksheet.
    Dim sAnchorCellTasksAddress As String
    sAnchorCellTasksAddress = "A1" '<= cell address of the upperleftmost cell in the student-specific workksheet.
    
'   Upperleftmost cell IN THE DATA in the tasks worksheet. This is a table header.
    Dim rAnchorCellTasks As Range
    Set rAnchorCellTasks = wsTasks.Range(sAnchorCellTasksAddress)
    
'   This is the column number for Item ID data header cell in the
'   the tasks worksheet data. E.g. if Item Id data is in column A
'   then this value is 1.
    Dim iTasksItemIDCol As Long
    iTasksItemIDCol = FindLabelColumn(rAnchorCellTasks, "Item ID")
    
'   This is the column number for CC Code data header cell in the
'   the tasks worksheet data. E.g. if CCCode data is in column C
'   then this value is 1.
    Dim iTasksCCCodeCol As Long
    iTasksCCCodeCol = FindLabelColumn(rAnchorCellTasks, "Code", xlPart)
    
'   This is the column number for Descriptor data header cell in the
'   the tasks worksheet data. E.g. if Descriptor data is in column D
'   then this value is 4.
    Dim iTasksDescriptorCol As Long
    iTasksDescriptorCol = FindLabelColumn(rAnchorCellTasks, "Descriptor")

'   This is the column number for "Task" links header cell in the
'   the tasks worksheet data. E.g. if Tasks links data is in column E
'   then this value is 5.
    Dim iTasksTaskLinkCol As Long
    iTasksTaskLinkCol = FindLabelColumn(rAnchorCellTasks, "Task")

'   ---------------------------------------------
'        Tasks Data Worksheet Freeze Panes
'   ---------------------------------------------

    wsTasks.Activate
    rAnchorCellTasks.Offset(1).EntireRow.Activate
    ActiveWindow.FreezePanes = True
    rAnchorCellTasks.Offset(1).Select

'   Add cell borders and alternating row shading using function BordersAndShading.
    Call BordersAndShading(rAnchorCellTasks)
    
'   ---------------------------------------------------------------
'       Student-specific Data Anchor Cells and Column Numbers
'   ---------------------------------------------------------------

    sStepID = "3. student-specific worksheet related setup"
    
'   Cell (object) in a student-specific worksheet containing the name.
    Dim rCellStudentName As Range
    
'   Address of cell in a student-specific worksheet containing the name.
    Dim sCellStudentNameAddress As String
    sCellStudentNameAddress = "A1"

'   Range that is the anchor cell in the student-specific data.
    Dim rAnchorStudentData As Range

'   Cell address for the anchor cell in the student-specific data.
    Dim sAnchorStudentDataAddress As String
    sAnchorStudentDataAddress = "A3" '<= cell address of the upperleftmost cell IN THE DATA
                                     '   in a student-specific worksheet.

'   This is the column number for Item ID data header cell in the
'   the student-specific worksheet data. E.g. if Item Id data is in
'   column A then this value is 1.
    Dim iStudentItemIDCol As Long
    iStudentItemIDCol = 1

'   This is the column number for difficulty data header cell in the
'   the student-specific worksheet data. E.g. if difficulty data is in
'   column B then this value is 2.
    Dim iStudentDifficultyCol As Long
    iStudentDifficultyCol = 2
    
'   This is the column number for CC Code data header cell in the
'   the student-specific worksheet data. E.g. if CC Code data is in
'   column C then this value is 3.
    Dim iStudentCCCodeCol As Long
    iStudentCCCodeCol = 3
    
'   This is the column number for Descriptor data header cell in the
'   the student-specific worksheet data. E.g. if Descriptor data is in
'   column D then this value is 4.
    Dim iStudentDescriptorCol As Long
    iStudentDescriptorCol = 4
    
'   This is the column number for Task Links header cell in the
'   the student-specific worksheet data. E.g. if Task Links are in
'   column E then this value is 5.
    Dim iStudentTaskLinkCol As Long
    iStudentTaskLinkCol = 5

'   Turn off screen updating and alerts regarding saving files, etc.
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With

'   -----------------------------------------------------------
'       Get Data Row Count and Load Array with Unique Names
'   -----------------------------------------------------------

    sStepID = "4. student data -- row count, unique names array"

'   Get count of rows containing student data in the "all students" data worksheet.
'   Used to iterate through all line items in the student's data.
    iDataRowsCount = rAnchorStudentsData.Cells(Rows.Count, 1).End(xlUp).Row - rAnchorStudentsData.Row
    
'   Load array with list of unique student names.
    Call LoadStudentArray(rAnchorStudentsData, asStudentsList())
    
'   ---------------------------------------------
'         Process All Unique Student Names
'   ---------------------------------------------

    sStepID = "5. processing all student's data"

'   Process each student.
    For iStudentIndex = 1 To UBound(asStudentsList())

'       Delete the student-specific worksheets if it already exists.
        On Error Resume Next
        ThisWorkbook.Worksheets(asStudentsList(iStudentIndex)).Delete
        On Error GoTo 0

'       Add the student-specific worksheet.
        Worksheets.Add(After:=Worksheets(Sheets.Count)).Name = asStudentsList(iStudentIndex)

'       Point the wsStudent worksheet object to the newly created worksheet.
        Set wsStudent = ThisWorkbook.Worksheets(asStudentsList(iStudentIndex))

'       Point rAnchorCellTargetData range object to the uppleftmost cell
'       in the data in student-specific worksheet. The cell address is in
'       var sAnchorCellTargetAddress.
        Set rAnchorStudentData = wsStudent.Range(sAnchorStudentDataAddress)

'       -----------------------------------------------
'              Process all Data for Each Student
'       -----------------------------------------------

        sStepID = "6. processing one student's data"

'       Put student name into cell specified by sCellStudentNameAddress then format.
        
        With wsStudent.Range(sCellStudentNameAddress)
            
            .Value = asStudentsList(iStudentIndex)
            
            With .Font
                .Bold = True
                .Size = 14
            End With
            
            .Offset(1).EntireRow.RowHeight = 5
            
        End With
        
        iStudentDataRow = 0
        
        For iDataRowIndex = 1 To iDataRowsCount

            sStepID = "6.a. getting student data"

'           If the data row iDataRowIndex for a student in the all students' data is not the
'           same as the student name being processed (which is in array asStudentsList) then
'           move to the next student.
            If rAnchorStudentsData.Offset(iDataRowIndex).Value = asStudentsList(iStudentIndex) _
             Then

'               Increment data row for student-specific data.
                iStudentDataRow = iStudentDataRow + 1
                
                sItemID = rAnchorStudentsData.Offset(iDataRowIndex, iStudentsItemIDCol - 1).Value

'               Put Item ID into student-specific data in student-specific worksheet.
                rAnchorStudentData.Offset(iStudentDataRow, iStudentItemIDCol - 1).Value = sItemID

'               Put difficulty into student-specific data in student-specific worksheet.
                  rAnchorStudentData.Offset(iStudentDataRow, iStudentDifficultyCol - 1).Value _
                = rAnchorStudentsData.Offset(iDataRowIndex, iStudentsDifficultyCol - 1).Value

'               Put CCCode into student-specific data in student-specific worksheet.
'               Lookup CCCode for Item ID using function LookupValueItemIDTasks.
                sCCCode = LookupValueItemIDTasks(sItemID, sAnchorCellTasksAddress, iTasksCCCodeCol)
                rAnchorStudentData.Offset(iStudentDataRow, iStudentCCCodeCol - 1).Value = sCCCode

'               Put Description into student-specific data in student-specific worksheet.
'               Lookup Description for Item ID using function LookupValueItemIDTasks.
                rAnchorStudentData.Offset(iStudentDataRow, iStudentDescriptorCol - 1).Value = _
                 LookupValueItemIDTasks(sItemID, sAnchorCellTasksAddress, iTasksDescriptorCol)

'               Put Task Link into student-specific data in student-specific worksheet.
                With wsStudent
                    .Hyperlinks.Add Anchor:=rAnchorStudentData.Offset(iStudentDataRow, iStudentTaskLinkCol - 1), _
                    Address:=sBaseURL & sCCCode, _
                    ScreenTip:="Get task information.", _
                    TextToDisplay:="Task"
                End With

'               Format the line item data being processed in student-specific worksheet.
                Call BordersAndShading(rAnchorStudentData, iDataRowIndex)

'               Check response = Incorrect
                bIsIncorrect = UCase(rAnchorStudentsData.Offset(iDataRowIndex, iStudentsResponseCol - 1).Value) = "INCORRECT"

'               If response is incorrect then highlight the cells in the data row.
                If bIsIncorrect _
                 Then

                    With rAnchorStudentData.Offset(iStudentDataRow).Resize(1, iStudentTaskLinkCol).Interior
                        .Pattern = xlSolid
                        .Color = 65535
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With

                End If

            End If

        Next iDataRowIndex

'       ---------------------------------------
'             Format Student-specific Data
'       ---------------------------------------

        sStepID = "6.b. formatting student data"

'       Put column header labels into the cells above the data. Format them too.
'       Do formatting by calling function FormatHeader.
        With rAnchorStudentData

            Call FormatHeader(.Cells(1), "Name")

            With .Offset(0, iStudentItemIDCol - 1)
                Call FormatHeader(.Cells(1), "Item ID")
            End With

            With .Offset(0, iStudentDifficultyCol - 1)
                Call FormatHeader(.Cells(1), "Difficulty")
            End With
            
            With .Offset(0, iStudentCCCodeCol - 1)
                Call FormatHeader(.Cells(1), "CC Code")
            End With
            
            With .Offset(0, iStudentDescriptorCol - 1)
                Call FormatHeader(.Cells(1), "Description")
            End With

            With .Offset(0, iStudentTaskLinkCol - 1)
                Call FormatHeader(.Cells(1), "Task")
            End With
                
        End With
        
'       -----------------------------------------------
'            Student Data Worksheet Freeze Panes
'       -----------------------------------------------

        rAnchorStudentData.Offset(1).EntireRow.Activate
        ActiveWindow.FreezePanes = True
        rAnchorStudentData.Offset(1).Select
        
'       -----------------------------------------
'             Save Student-specific Workbook
'       -----------------------------------------

        sStepID = "6.c. saving student data worksheet"

'       Path to and name of student-specific file to save.
        sPathAndFile = ThisWorkbook.Path & "\" & asStudentsList(iStudentIndex) & ".xlsx"
        
        Application.DisplayAlerts = False

        wsStudent.Move
        
        With ActiveWorkbook
            .SaveAs Filename:=sPathAndFile
            .Close
        End With
        
'       -----------------------------------------------
'             Send Email to Student with Workbook
'       -----------------------------------------------

        sStepID = "6.d. sending email to student"

'       If boolean flag bDoEmail is true then process email.
        If bDoEmail _
         Then

            sEmailAddress = LookupEmailAddress(asStudentsList(iStudentIndex))
            
            If sEmailAddress <> "" _
             Then
                Call SendEmail(sEmailAddress, sEmailSubject, sEmailBody, "") 'sPathAndFile
                
                If bDeleteWorksheetAfterEmail Then Kill sPathAndFile
            
            Else
                MsgBox "There is no email address for " & asStudentsList(iStudentIndex) & ".", vbInformation
            End If
        End If
'
        ThisWorkbook.Activate
        
    Next iStudentIndex
    
'   -------------------------------------------------------------------
'        "Done" Message then Activate All Students' Data Worksheet
'   -------------------------------------------------------------------

    MsgBox "Done processing " & UBound(asStudentsList) & " students."
    
    wsStudents.Activate
    
Exit Sub

ErrHandler:

Call ErrorMessage(Err.Number, Err.Description, sSubName, sStepID)
    
End Sub

Option Explicit

' ----------------------------------------------------------------
' Procedure Name: BordersAndShading
' Purpose: Add cell borders and row shading to a worksheet.
' Procedure Kind: Function
' Procedure Access: Public
' Parameter prAnchorcell (Range): Anchor cell for data.
' Author: Jim
' Date: 6/14/2023
' ----------------------------------------------------------------

Function BordersAndShading(prAnchorcell As Range, Optional piRow As Long = 0)
    
    Dim iRows As Long
    
    Dim iCols As Long
    
    Dim iRowOffset As Long
        
    With prAnchorcell
        
        If piRow <> 0 _
         Then
            iRows = 1
            iRowOffset = piRow
        Else
            iRows = .CurrentRegion.Rows.Count - 1
            iRowOffset = 1
        End If
        
        iCols = .CurrentRegion.Columns.Count
        
        With .Offset(iRowOffset).Resize(iRows, iCols)
        
'           -------------------------------
'                   Cell Borders
'           -------------------------------
        
            With .Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .Weight = xlThin
            End With

            With .Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .Weight = xlThin
            End With

            With .Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .Weight = xlThin
            End With

            With .Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .Weight = xlThin
            End With

            With .Borders(xlInsideVertical)
                .LineStyle = xlContinuous
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .Weight = xlThin
            End With

            With .Borders(xlInsideHorizontal)
                .LineStyle = xlContinuous
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .Weight = xlThin
            End With
            
'           -------------------------------
'                Alternate Row Shading
'           -------------------------------

            If piRow = 0 _
             Then

                .FormatConditions.Add Type:=xlExpression, Formula1:= _
                    "=MOD(ROW(),2)=1"
                
                .FormatConditions(.FormatConditions.Count).SetFirstPriority
                
                With .FormatConditions(1).Interior
                    .Pattern = xlGray16
                    .PatternThemeColor = xlThemeColorDark1
                    .ColorIndex = xlAutomatic
                    .PatternTintAndShade = -0.349986266670736
                End With
                
                .FormatConditions(1).StopIfTrue = False
            
            End If
        
        End With
     
    End With

End Function

Option Explicit

'Use to render the error messages from error handler.
Function ErrorMessage( _
    pErrNum As Integer, _
    psErrDescr, _
    Optional psSubName = "", _
    Optional psStepID = "")
    
'    If pErrNum = 18 Then Exit Function

    Dim sMsg As String
        
    Dim sTitle As String
    
    sTitle = "Error Message"
    
    sMsg = "Error #" & pErrNum & " occurred"
    
    If psSubName <> "" _
     Then sMsg = sMsg & Chr(10) & "in procedure " & psSubName
    
    sMsg = sMsg & "."
    
    If psStepID <> "" _
     Then sMsg = sMsg & Chr(10) & "Step ID: " & psStepID & "."
    
    sMsg = sMsg & Chr(10) & "Error Type: " & psErrDescr & "."
    
    MsgBox sMsg, vbOKOnly + vbCritical, sTitle
    
    Err.Clear
    
    Application.StatusBar = False
    DoEvents

End Function

Option Explicit

' ----------------------------------------------------------------
' Procedure Name: FindLabelColumn
' Purpose: Find the column # for the specified label in a worksheet's headers.
' Procedure Kind: Function
' Procedure Access: Public
' Parameter prAnchor (Range): Upperleftmost header cell.
' Parameter psValue (String): Value to find.
' Parameter piLookAt (Long): Look at 1) xlPart of word or 2) xlWhole word.
' Return Type: Long
' Author: Jim
' Date: 6/14/2023
' ----------------------------------------------------------------
Function FindLabelColumn(prAnchor As Range, psValue As String, Optional piLookAt As Long = xlWhole) As Long

    Dim rFoundCell As Range

    Set rFoundCell = prAnchor.EntireRow.Find( _
        What:=psValue, _
        LookIn:=xlFormulas, _
        LookAt:=piLookAt, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, _
        MatchCase:=False, _
        SearchFormat:=False)
    
    FindLabelColumn = rFoundCell.Column

End Function

Option Explicit

' ----------------------------------------------------------------
' Procedure Name: FormatHeader
' Purpose: Format header cells in student-specific worksheet.
' Procedure Kind: Function
' Procedure Access: Public
' Parameter prTarget (Range): The cell that is to be formatted and filled.
' Parameter psValue (String): The value that goes into the cell.
' Author: Jim
' Date: 6/8/2023
' ----------------------------------------------------------------

Function FormatHeader(prTarget As Range, psValue As String)

    With prTarget
        
'       Header value (label).
        .Value = psValue

'       Header white font.
        With .Font
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = 0
            .Bold = True
        End With
        
'       Alignment
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
     
'       Font bold, size 12
        .Font.FontStyle = "Bold"
        .Font.Size = 12
        
'       Add white thin borders
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .ThemeColor = 1
            .TintAndShade = 0
            .Weight = xlThin
        End With
        
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .ThemeColor = 1
            .TintAndShade = 0
            .Weight = xlThin
        End With
        
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ThemeColor = 1
            .TintAndShade = 0
            .Weight = xlThin
        End With
        
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .ThemeColor = 1
            .TintAndShade = 0
            .Weight = xlThin
        End With
        
'       Header gray fill.
        With .Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = -0.349986266670736
        End With
        
'       Autofit the column.
        .EntireColumn.AutoFit
    
    End With

End Function

Option Explicit
Option Base 1

' ----------------------------------------------------------------
' Procedure Name: LoadStudentArray
' Purpose: Load list of unique student names into ByRef array parameter.
' Procedure Kind: Function
' Procedure Access: Public
' Parameter prDataAnchor (Range): Upperleftmost cell that anchors all students' data.
' Parameter pasStudentList (String): ByRef array parameter holding unique student names.
' Return Type: String)
' Author: Jim
' Date: 6/8/2023
' ----------------------------------------------------------------

Function LoadStudentArray(ByVal prDataAnchor As Range, ByRef pasStudentList() As String)

    Dim iRowOffset As Long
    
    Dim iRowsCount As Long
    
    Dim sPreviousName As String
    
    Dim iNamesCount As Long
        
    iRowsCount = prDataAnchor.Cells(Rows.Count, 1).End(xlUp).Row - prDataAnchor.Row

    sPreviousName = ""
    
    For iRowOffset = 1 To iRowsCount
        
        If prDataAnchor.Offset(iRowOffset).Value <> sPreviousName _
         Then
            iNamesCount = iNamesCount + 1
            
            ReDim Preserve pasStudentList(iNamesCount)
            
            pasStudentList(iNamesCount) = prDataAnchor.Offset(iRowOffset).Value
            
            sPreviousName = prDataAnchor.Offset(iRowOffset).Value
        
        End If
    
    Next
    
End Function

Option Explicit

' ----------------------------------------------------------------
' Procedure Name: LookupValueItemIDTasks
' Purpose: Lookup value for the specified Item ID in the Tasks worksheet.
' Procedure Kind: Function
' Procedure Access: Public
' Parameter psItemID (String): Item ID to search for.
' Parameter psAnchorCellAddress (String): Address of anchor cell for data.
' Parameter piColNum (Long): Column number of data to return.
' Author: Jim
' Date: 6/14/2023
' ----------------------------------------------------------------

Function LookupValueItemIDTasks( _
 psItemID As String, _
 psAnchorCellAddress As String, _
 piColNum As Long)

    Dim wsTasks As Worksheet

    Dim iDataRows As Long

    Dim iDataRow As Long

    Dim rIDHeader As Range

    Dim rValueAnchor As Range

    Set wsTasks = ThisWorkbook.Worksheets("Tasks")

    Set rIDHeader = wsTasks.Range(psAnchorCellAddress)

    Set rValueAnchor = rIDHeader.Offset(0, piColNum - 1)

    iDataRows = rIDHeader.Cells(Rows.Count, 1).End(xlUp).Row - rIDHeader.Row

    For iDataRow = 1 To iDataRows

        If psItemID = rIDHeader.Offset(iDataRow) _
         Then

            LookupValueItemIDTasks = rValueAnchor.Offset(iDataRow)

            Exit Function

        End If

    Next

End Function

Option Explicit

' ----------------------------------------------------------------
' Procedure Name: LookupEmailAddress
' Purpose: Lookup email address for the specified person in Email worksheet.
' Procedure Kind: Function
' Procedure Access: Public
' Parameter psName (String): Name of person for which email address is sought.
' Author: Jim
' Date: 6/15/2023
' ----------------------------------------------------------------

Function LookupEmailAddress(psName As String)
        
    Dim rAnchorCell As Range
    
    Dim iName As Long
    
    LookupEmailAddress = "x"
    
    Set rAnchorCell = ThisWorkbook.Worksheets("Email").Range("A1")
        
    iName = 0
        
    With rAnchorCell
        Do
            iName = iName + 1

            If .Offset(iName).Value = psName _
             Then
                LookupEmailAddress = .Offset(iName, 1).Value
                Exit Function
            End If

        Loop Until .Offset(iName + 1).Value = ""
        
    End With

End Function

' ----------------------------------------------------------------
' Procedure Name: SendEmail
' Purpose: Send email to the specified address with specified attachment.
' Procedure Kind: Function
' Procedure Access: Public
' Parameter psEmailAddress (String): Email address to send email to.
' Parameter psEmailSubject (String): Email subject line content.
' Parameter sEmailBody (String): Email body content.
' Parameter psPathAndFile (String): Path and file name for the attachment.
' Parameter pbDoSend (Boolean): 1. Send email (True), 2. "display" email first (False).
' Author: Jim
' Date: 6/15/2023
' ----------------------------------------------------------------

Function SendEmail( _
    psEmailAddress As String, _
    psEmailSubject As String, _
    sEmailBody As String, _
    Optional psPathAndFile As String = "", _
    Optional pbDoSend As Boolean = True)
    
'   Objects used for sending email via outlook.
    Dim oOutlookApp As Object
    Dim oMailItem As Object
    
'   Set up Outlook objects for sending email.
    Set oOutlookApp = CreateObject("Outlook.Application")
    Set oMailItem = oOutlookApp.CreateItem(0)
    
'   Four scenarios
'   1. no attachment, do send
'   2. with attachment, do send
'   3. no attachment, do not send -- do display before sending
'   4. with attachment, do not send -- do display before sending
    
    If psPathAndFile = "" And pbDoSend _
     Then
'       Without attachment
        With oMailItem
            .To = psEmailAddress  'Specify the email address of the recipient
            .Subject = psEmailSubject
            .Body = sEmailBody
            .Send
        End With
     
     ElseIf psPathAndFile <> "" And pbDoSend _
      Then
        With oMailItem
            .To = psEmailAddress  'Specify the email address of the recipient
            .Subject = psEmailSubject
            .Body = sEmailBody
            .Attachments.Add psPathAndFile
            .Send
        End With
         
    If psPathAndFile = "" And Not pbDoSend _
     Then
'       Without attachment
        With oMailItem
            .To = psEmailAddress  'Specify the email address of the recipient
            .Subject = psEmailSubject
            .Body = sEmailBody
            .Display
        End With
         
    Else 'psPathAndFile <> "" And Not pbDoSend
    
        With oMailItem
            .To = psEmailAddress  'Specify the email address of the recipient
            .Subject = psEmailSubject
            .Body = sEmailBody
            .Attachments.Add psPathAndFile
            .Display
        End With
    
    End If

End Function

 

[joshlee]

You are a legend my friend!