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!

 

[joshlee]

Sorry - I am a excel noob, if I wanted to adjust so that it applies to all the students listed which parameter should I adjust?

 

[joshlee]

Take that back - I see what I need to do all good. Thanks again!

 

[joshlee]

Hi Jim - I am sorry, but I have updated my links...this will have to be done each year but they are not updated on the student sheets....would it be possible to just make it so that the student sheets duplicate the Task sheet? Here is the updated sheet . Thank you!

 

[OaklandJim]

It has been a while since I looked at this. To help me understand what is needed please give me some more detail.

 

[joshlee]

Hi yes no worries - the excel doc used student data to produce a individual sheet for each student with their errors highlighted.
The student's sheet is a duplicate of the 'Task' sheet. In my previous iteration I had placeholder hyperlinks in the ask sheet.

I have now updated them, but when I run the macro that you so kindly created, it still uses the placeholder hyperlinks.
If you could change it so that I can edit the links on the 'Task' sheet and it will be duplicated for each student that would be amazing.
Just that I will have to edit those links each year.

 

[OaklandJim]

I'm looking at the workbook and I am not up to speed yet regarding what the code that I provided does. I confuse myself sometimes.

First, check URLs for rows 10 - 11 and 39 - 44 in tasks.

Help me to recall...for each student an individual worksheet is created which includes all of the data rows for that student from the Student Results worksheet. Incorrect answers are highlighted. Then, I use the Item ID to look up the corresponding link URL in the Tasks worksheet. That link is placed into the rows for the student-specific worksheet so they have a link to the respective content. Is that right?

 

[joshlee]

Hi Jim

Yes my links for 10-11 and 39-44 were not completed correctly - thankyou for the pick up updated here

Yes that would work. A possible easier option could be just make a duplicate of the task sheet for each student, and then highlight their errors.

Your previous iteration worked great, I just need the task sheet duplicated for each student so that the links are accurate and I have the option to adjust them.

 

[OaklandJim]

Unfortunately your data has some crud in it that has been affecting my test results. For example there are two Edwards. I'll need to make one Edward 2 to get my code to work correctly (i.e., each name must be unique). I do understand why you only gave me first names.

For Joan one Item ID is not in the task list: x00027613. I'll let you fix THAT when I send the next version of the file.

I am working away and I hope to have a new workbook in two or three days or so.

 

[OaklandJim]

I hope that I got this right. If not let me know! The new workbook is HERE.

I added auditing code that checks whether each Item ID in the student data (worksheet) exists in the Tasks worksheet. x00027613 shows up for several students. So add that into the Tasks worksheet when you get the workbook. Similarly, I added a column in the tasks worksheet that shows the URL for each link. That allows you to audit the links more easily. Feel free to remove that.

The student worksheet has a button to create all student-specific workbooks There is also a button that deletes all student-specific workbooks. Beware...it deletes ALL files with the .xlsx file extension. So do not store other workbooks with the .xlsx file extension in the same directory as the student workbook or they'll be deleted when using that button. The third button looks to see whether a specific Item ID listed in the student worksheet exists in the Tasks worksheet. I added a column into which No is placed if the Item ID is not found.

To send emails with workbooks attached there is a button in the Email worksheet. Before emailing workbooks to students make sure that for the list of names in the Email worksheet names are exactly the same as they are in the student worksheet or code does not know which workbooks to send to who.

Caveat If you change the name of a worksheet or if you change the order of the columns in a worksheet the code will crash.

All that said, I could only test so much, especially because there I did not have email addresses. I tested with mine. It seems to work. There are bound to be issues so let me know if problems exist.

New or different code...

' ----------------------------------------------------------------
' Procedure Name: EmailWorksheets
' Purpose: Send emails with student-specific workbooks attatched.
' Procedure Kind: Sub
' Procedure Access: Public
' Author: Jim
' Date: 8/11/2023
' ----------------------------------------------------------------

Sub EmailWorksheets()

'   Worksheet objet for the Email worksheet
    Dim wsEmail As Worksheet
    
'   Name of email recipient.
    Dim sName As String
    
'   Email adress of recipient.
    Dim sEmailAddress As String
       
'   Location of the workbooks.
    Dim sPath As String
    
'   Used for looping through each name/email address entries.
    Dim iRow As Long
    
'   The last occupied row in the Email worksheet.
    Dim iLastRow As Long
    
'   Count of emails sent.
    Dim iEmailsSent As Long
    
'   Used to get user response to question re: delete workbooks after sending.
    Dim vAns As Variant
    
'   Ask user if she wants to delete workbooks after emails are sent.
    vAns = MsgBox("Delete worksheets after email is sent?", vbYesNo + vbQuestion)
    
'   Folder/location of the workbooks to be sent.
    sPath = ThisWorkbook.Path
    
'   Point object variable to the Email worksheet.
    Set wsEmail = Worksheets("Email")
    
'   Get the last occupied row in the Email addresses.
    iLastRow = wsEmail.Range("A1").End(xlDown).Row
        
    With wsEmail
     
        For iRow = 1 To iLastRow - 1
        
            sName = .Range("A1").Offset(iRow).Value
            
            sEmailAddress = .Range("B1").Offset(iRow).Value
            
            If Dir(sPath & "\" & sName & ".xlsx") <> "" _
             Then
                
                iEmailsSent = iEmailsSent + 1
             
'               Send Email using the SendEmail function.
                Call SendEmail(sEmailAddress, _
                               "Task worksheet for " & sName, _
                               "Attached please find your tasks worksheet.Highlighted rows need your attention.", _
                               sPath & "\" & sName & ".xlsx")
            End If
            
            If vAns = vbYes _
             Then
                On Error Resume Next
                Kill (sPath & "\" & sName & ".xlsx")
                On Error GoTo 0
            End If
            
        Next iRow
     
    End With

    MsgBox iEmailsSent & " emails were sent.", vbInformation

End Sub

' Procedure Name: GetURLForItemID
' Purpose: Retrieves the URL for a specified Item ID
' Procedure Kind: Function
' Procedure Access: Public
' Parameter psItemID (String): Itme ID for which the URL is retrieved.
' Author: Jim
' Date: 8/10/2023
' ----------------------------------------------------------------
Function GetURLForItemID(psItemID As String) As String

    Dim wsTasks As Worksheet
    
    Dim iRow As Long
    
    Dim iLastRow As Long
    
    Dim iURLOffset As Long
    
    Set wsTasks = Worksheets("Tasks")
    
'   Get the last row containing data.
    iLastRow = wsTasks.Range("A1").End(xlDown).Row
    
'   Assume that the URL for the Item ID is in column 5 (offset 4 from
'   the Item ID column) in the Tasks worksheet.
    iURLOffset = 4 'Column E
    
'   Assume that the Item ID is in column 1 in the Tasks worksheet.
    With wsTasks.Range("A1")

        For iRow = 1 To iLastRow - 1
            If .Offset(iRow).Value = psItemID _
             Then
                On Error Resume Next
                GetURLForItemID = .Offset(iRow, iURLOffset).Hyperlinks(1).Address
                On Error GoTo 0
                
                Exit For
            
            End If
        
        Next iRow

    End With

End Function

' ----------------------------------------------------------------
' 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)
    
    If Dir(psPathAndFile) = "" _
     Then
        MsgBox "The specified attachment" _
               & Chr(10) _
               & psPathAndFile _
               & Chr(10) _
               & "was not found. Email not sent."
        Exit Function
    End If
    
'   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
        
    ElseIf 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
        
'   Address of the print area for a student worksheet
    Dim sPrintRangeAddress As String
        
'   The URL used to put a link to the task into the hyperlink cell.
    Dim sURLForLink As String
    
    Dim iLastRow As Long
        
'   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 indicating whether Student's response is correct for an Item ID.
    Dim bIsIncorrect As Boolean
    
'   Boolean var holding True or False indicating whether Student did not attempt an Item ID.
    Dim bNotAttempted 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
'   --------------------------------
       
    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 whether to delete worksheet after email.

    Application.EnableEvents = False

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

    sStepID = "1. students' worksheet related setup"

'   Name of worksheet containing all students' data.
    sAllStudentsWorksheetName = "Student Results"  '<= 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 worksheet.
    
'   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 Worksheet Freeze Panes and Shading
'   --------------------------------------------------

    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

    wsStudents.Activate
        
'   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())
        
        wsStudents.Activate
        
        With Application
            .ScreenUpdating = True
            .Wait (Now + TimeValue("0:00:01"))
            .StatusBar = "Processing student #" & iStudentIndex
            .ScreenUpdating = False
        End With
        
'       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)
        
'       Error Handling
        sStepID = "6. processing each student's data"
        
'       -----------------------------------------------
'                        Page Setup
'       -----------------------------------------------
        
        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

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

'       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.b. 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)

'               Get URL for the Item ID
                sURLForLink = GetURLForItemID(sItemID)

'               Put Task Link into student-specific data in student-specific worksheet.
                With wsStudent
                    .Hyperlinks.Add Anchor:=rAnchorStudentData.Offset(iStudentDataRow, iStudentTaskLinkCol - 1), _
                    Address:=sURLForLink, _
                    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 or Not Attempted
                bIsIncorrect = UCase(rAnchorStudentsData.Offset(iDataRowIndex, iStudentsResponseCol - 1).Value) = "INCORRECT"
                
                bNotAttempted = UCase(rAnchorStudentsData.Offset(iDataRowIndex, iStudentsResponseCol - 1).Value) = "NOT ATTEMPTED"

'               If response is incorrect then highlight the cells in the data row.
                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

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

        sStepID = "6.c. 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
'       -----------------------------------------------

        sStepID = "6.d. adding freeze panes and print area"

        rAnchorStudentData.Offset(1).EntireRow.Activate
        ActiveWindow.FreezePanes = True
        rAnchorStudentData.Offset(1).Select
        
'       -----------------------------------------------
'            Student Data Worksheet Print Area
'       -----------------------------------------------
        
        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
        
'       -------------------------------------------
'             Delete extra rows at the bottom
'       -------------------------------------------

        sStepID = "6.e. deleting extra rows"

'       Oddly, SOMETIMES my code adds empty lines at the bottom of the list of tasks
'       in the workbooks => workshets created for a given student. So I just lop off
'       any extra rows below where student data ends.
        
        On Error Resume Next
        wsStudent.Rows(iLastRow + 1).Resize(5000).EntireRow.Delete
        On Error GoTo ErrHandler
                
'       -----------------------------------------
'             Save Student-specific Workbook
'       -----------------------------------------

        sStepID = "6.f. 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.g. 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
    
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

 

[joshlee]

You are an icon! Thank you so much