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
