Option Explicit
Option Base 1
Sub ProcessStudentData()
Dim sSubName As String
Dim sStepID As String
sSubName = "Sub ProcessStudentData"
sStepID = ""
On Error GoTo ErrHandler
Dim wsStudents As Worksheet
Dim wsTasks As Worksheet
Dim wsStudent As Worksheet
Dim asStudentsList() As String
Dim iStudentIndex As Long
Dim iStudentDataRow As Long
Dim sStudentName As String
Dim sItemID As String
Dim sCCCode As String
Dim sBaseURL As String
Dim sAllStudentsWorksheetName As String
Dim sTasksWorksheetName As String
Dim sPathAndFile As String
Dim iDataRowsCount As Long
Dim iDataRowIndex As Long
Dim bIsIncorrect As Boolean
Dim bDoEmail As Boolean
Dim bDeleteWorksheetAfterEmail As Boolean
Dim sEmailAddress As String
Dim sEmailSubject As String
Dim sEmailBody As String
sBaseURL = "https://mathspace.co/textbooks/syllabuses/Syllabus-1038/?selectTextbook=false&searchString="
sEmailSubject = "Tasks worksheet"
sEmailBody = "Attached please find a worksheet with your tasks data."
If Application.Caller = "ProcessNoEmail_Button" Then bDoEmail = False Else bDoEmail = True
bDeleteWorksheetAfterEmail = False
sStepID = "1. students' worksheet related setup"
sAllStudentsWorksheetName = "Student Results Table"
Set wsStudents = ThisWorkbook.Worksheets(sAllStudentsWorksheetName)
Dim sAnchorStudentsAddress As String
sAnchorStudentsAddress = "A1"
Dim rAnchorStudentsData As Range
Set rAnchorStudentsData = wsStudents.Range(sAnchorStudentsAddress)
Dim iStudentsItemIDCol As Long
iStudentsItemIDCol = FindLabelColumn(rAnchorStudentsData, "Item ID")
Dim iStudentsDifficultyCol As Long
iStudentsDifficultyCol = FindLabelColumn(rAnchorStudentsData, "Difficulty", xlPart)
Dim iStudentsResponseCol As Long
iStudentsResponseCol = FindLabelColumn(rAnchorStudentsData, "Response", xlPart)
wsStudents.Activate
rAnchorStudentsData.Offset(1).EntireRow.Activate
ActiveWindow.FreezePanes = True
rAnchorStudentsData.Offset(1).Select
Call BordersAndShading(rAnchorStudentsData)
sStepID = "2. tasks worksheet related setup"
sTasksWorksheetName = "Tasks"
Set wsTasks = ThisWorkbook.Worksheets(sTasksWorksheetName)
Dim sAnchorCellTasksAddress As String
sAnchorCellTasksAddress = "A1"
Dim rAnchorCellTasks As Range
Set rAnchorCellTasks = wsTasks.Range(sAnchorCellTasksAddress)
Dim iTasksItemIDCol As Long
iTasksItemIDCol = FindLabelColumn(rAnchorCellTasks, "Item ID")
Dim iTasksCCCodeCol As Long
iTasksCCCodeCol = FindLabelColumn(rAnchorCellTasks, "Code", xlPart)
Dim iTasksDescriptorCol As Long
iTasksDescriptorCol = FindLabelColumn(rAnchorCellTasks, "Descriptor")
Dim iTasksTaskLinkCol As Long
iTasksTaskLinkCol = FindLabelColumn(rAnchorCellTasks, "Task")
wsTasks.Activate
rAnchorCellTasks.Offset(1).EntireRow.Activate
ActiveWindow.FreezePanes = True
rAnchorCellTasks.Offset(1).Select
Call BordersAndShading(rAnchorCellTasks)
sStepID = "3. student-specific worksheet related setup"
Dim rCellStudentName As Range
Dim sCellStudentNameAddress As String
sCellStudentNameAddress = "A1"
Dim rAnchorStudentData As Range
Dim sAnchorStudentDataAddress As String
sAnchorStudentDataAddress = "A3"
Dim iStudentItemIDCol As Long
iStudentItemIDCol = 1
Dim iStudentDifficultyCol As Long
iStudentDifficultyCol = 2
Dim iStudentCCCodeCol As Long
iStudentCCCodeCol = 3
Dim iStudentDescriptorCol As Long
iStudentDescriptorCol = 4
Dim iStudentTaskLinkCol As Long
iStudentTaskLinkCol = 5
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
sStepID = "4. student data -- row count, unique names array"
iDataRowsCount = rAnchorStudentsData.Cells(Rows.Count, 1).End(xlUp).Row - rAnchorStudentsData.Row
Call LoadStudentArray(rAnchorStudentsData, asStudentsList())
sStepID = "5. processing all student's data"
For iStudentIndex = 1 To UBound(asStudentsList())
On Error Resume Next
ThisWorkbook.Worksheets(asStudentsList(iStudentIndex)).Delete
On Error GoTo 0
Worksheets.Add(After:=Worksheets(Sheets.Count)).Name = asStudentsList(iStudentIndex)
Set wsStudent = ThisWorkbook.Worksheets(asStudentsList(iStudentIndex))
Set rAnchorStudentData = wsStudent.Range(sAnchorStudentDataAddress)
sStepID = "6. processing one student's data"
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 rAnchorStudentsData.Offset(iDataRowIndex).Value = asStudentsList(iStudentIndex) _
Then
iStudentDataRow = iStudentDataRow + 1
sItemID = rAnchorStudentsData.Offset(iDataRowIndex, iStudentsItemIDCol - 1).Value
rAnchorStudentData.Offset(iStudentDataRow, iStudentItemIDCol - 1).Value = sItemID
rAnchorStudentData.Offset(iStudentDataRow, iStudentDifficultyCol - 1).Value _
= rAnchorStudentsData.Offset(iDataRowIndex, iStudentsDifficultyCol - 1).Value
sCCCode = LookupValueItemIDTasks(sItemID, sAnchorCellTasksAddress, iTasksCCCodeCol)
rAnchorStudentData.Offset(iStudentDataRow, iStudentCCCodeCol - 1).Value = sCCCode
rAnchorStudentData.Offset(iStudentDataRow, iStudentDescriptorCol - 1).Value = _
LookupValueItemIDTasks(sItemID, sAnchorCellTasksAddress, iTasksDescriptorCol)
With wsStudent
.Hyperlinks.Add Anchor:=rAnchorStudentData.Offset(iStudentDataRow, iStudentTaskLinkCol - 1), _
Address:=sBaseURL & sCCCode, _
ScreenTip:="Get task information.", _
TextToDisplay:="Task"
End With
Call BordersAndShading(rAnchorStudentData, iDataRowIndex)
bIsIncorrect = UCase(rAnchorStudentsData.Offset(iDataRowIndex, iStudentsResponseCol - 1).Value) = "INCORRECT"
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
sStepID = "6.b. formatting student data"
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
rAnchorStudentData.Offset(1).EntireRow.Activate
ActiveWindow.FreezePanes = True
rAnchorStudentData.Offset(1).Select
sStepID = "6.c. saving student data worksheet"
sPathAndFile = ThisWorkbook.Path & "\" & asStudentsList(iStudentIndex) & ".xlsx"
Application.DisplayAlerts = False
wsStudent.Move
With ActiveWorkbook
.SaveAs Filename:=sPathAndFile
.Close
End With
sStepID = "6.d. sending email to student"
If bDoEmail _
Then
sEmailAddress = LookupEmailAddress(asStudentsList(iStudentIndex))
If sEmailAddress <> "" _
Then
Call SendEmail(sEmailAddress, sEmailSubject, sEmailBody, "")
If bDeleteWorksheetAfterEmail Then Kill sPathAndFile
Else
MsgBox "There is no email address for " & asStudentsList(iStudentIndex) & ".", vbInformation
End If
End If
ThisWorkbook.Activate
Next iStudentIndex
MsgBox "Done processing " & UBound(asStudentsList) & " students."
wsStudents.Activate
Exit Sub
ErrHandler:
Call ErrorMessage(Err.Number, Err.Description, sSubName, sStepID)
End Sub