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 sPrintRangeAddress As String
Dim sURLForLink As String
Dim iLastRow As Long
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 bNotAttempted As Boolean
Dim bDoEmail As Boolean
Dim bDeleteWorksheetAfterEmail As Boolean
Dim sEmailAddress As String
Dim sEmailSubject As String
Dim sEmailBody As String
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
Application.EnableEvents = False
sStepID = "1. students' worksheet related setup"
sAllStudentsWorksheetName = "Student Results"
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
wsStudents.Activate
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())
wsStudents.Activate
With Application
.ScreenUpdating = True
.Wait (Now + TimeValue("0:00:01"))
.StatusBar = "Processing student #" & iStudentIndex
.ScreenUpdating = False
End With
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 each student's data"
sStepID = "6.a. formating student data worksheet"
With wsStudent
With .PageSetup
.Orientation = xlLandscape
.LeftFooter = "Created &D @ &T"
.CenterFooter = "&P of &N"
End With
End With
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.b. 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)
sURLForLink = GetURLForItemID(sItemID)
With wsStudent
.Hyperlinks.Add Anchor:=rAnchorStudentData.Offset(iStudentDataRow, iStudentTaskLinkCol - 1), _
Address:=sURLForLink, _
ScreenTip:="Get task information.", _
TextToDisplay:="Task"
End With
Call BordersAndShading(rAnchorStudentData, iDataRowIndex)
bIsIncorrect = UCase(rAnchorStudentsData.Offset(iDataRowIndex, iStudentsResponseCol - 1).Value) = "INCORRECT"
bNotAttempted = UCase(rAnchorStudentsData.Offset(iDataRowIndex, iStudentsResponseCol - 1).Value) = "NOT ATTEMPTED"
If bIsIncorrect Or bNotAttempted _
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.c. 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
sStepID = "6.d. adding freeze panes and print area"
rAnchorStudentData.Offset(1).EntireRow.Activate
ActiveWindow.FreezePanes = True
rAnchorStudentData.Offset(1).Select
With wsStudent
iLastRow = .Range("A" & Rows.Count).End(xlUp).Row
sPrintRangeAddress = .Range("A1").Resize(iLastRow, 5).Address
.PageSetup.PrintArea = sPrintRangeAddress
.PageSetup.PrintTitleRows = "$1:$3"
End With
sStepID = "6.e. deleting extra rows"
On Error Resume Next
wsStudent.Rows(iLastRow + 1).Resize(5000).EntireRow.Delete
On Error GoTo ErrHandler
sStepID = "6.f. 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.g. sending email to student"
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
MsgBox "Done processing " & UBound(asStudentsList) & " students."
wsStudents.Activate
Closeout:
With Application
.CalculateFull
.EnableEvents = True
.StatusBar = False
End With
Exit Sub
ErrHandler:
Call ErrorMessage(Err.Number, Err.Description, sSubName, sStepID)
GoTo Closeout
End Sub