Roster data

jschreiber69

New Member
Joined
Mar 6, 2021
Messages
6
Office Version
  1. 365
Platform
  1. MacOS
Hello all,

I am try to convert an Excel file of course requests from thousands of rows of individual requests (all containing the Student id) to a create a new Workbook or sheet that contains 1 row of data per student with all the requests in separate columns. The number of requests per student is not a fixed number but the student id is on each line with their request. I figure this is pretty basic for people who know excel. We normally would just print out a report and give directly to students. Due to COVID-19, we are fully virtual and I will be using the new workbook or sheet that is created for an email merge. I have provided a short video to explain what I am looking for and would appreciate your help.

Thanks, Joe

Video explanation of Request
 

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off
Welcome to the forum!

Sure, that is easy. You can post a link to a shared file from Dropbox or OneDrive or such if you like. The sample file(s) helps me help you more easily.

If you were using Outlook, I could have helped with that too.
 
Upvote 0
request_detail_report (6-35PM).xlsx
ABCDEFGHI
1Course NumberCourse NameRequest TypeGradeStudent LastNameStudent FirstNameStudent MiddleInitialStudentNumber
request_detail_report (6-35PM)




I really appreciate this. Thank you so much Mr. Hobson.



Also here is the link to some sample data:
Sample Roster Data.xlsx
 
Upvote 0
You can delete that file if it has sensitive data. Short example files with obfuscated sensitive data is best for public forums.
 
Upvote 0
request_detail_report (6-35PM).xlsx
ABCDEFGHI
1Course NumberCourse NameRequest TypeGradeStudent LastNameStudent FirstNameStudent MiddleInitialStudentNumber
request_detail_report (6-35PM)
 
Upvote 0
Since those have different column headings, what would be the headings for the transposed worksheet?
 
Upvote 0
Basically just need ID, Last, First, Course Name1 , Course Name 2, ..... etc.
I don't need the course numbers for the second sheet
 
Upvote 0
Make sure you have a Sheet2 and then try:
VBA Code:
Sub RosterData()
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, desWS As Worksheet, v As Variant, dic As Object, fVisRow As Long, lVisRow As Long, cnt As Long
    Set srcWS = Sheets("Sheet1")
    Set desWS = Sheets("Sheet2")
    v = srcWS.Range("B2", srcWS.Range("B" & Rows.Count).End(xlUp)).Resize(, 7).Value
    Set dic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(v)
        If Not dic.Exists(v(i, 7)) Then
            dic.Add v(i, 7), Nothing
            With srcWS
                .Range("A1").AutoFilter 8, v(i, 7)
                cnt = .[subtotal(103,A:A)] - 1
                fVisRow = .AutoFilter.Range.Offset(1, 0).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row
                lVisRow = .Cells(.Rows.Count, "A").End(xlUp).Row
                desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1).Resize(, 3) = Array(v(i, 7), v(i, 4), v(i, 5))
                desWS.Cells(desWS.Rows.Count, "D").End(xlUp).Offset(1).Resize(, cnt) = Application.WorksheetFunction.Transpose(.Range("B" & fVisRow & ":B" & lVisRow).Value)
            End With
        End If
    Next i
    srcWS.Range("a1").AutoFilter
    desWS.Columns.AutoFit
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Since you are use MAC version, I did not use the dictionary method. Here is my solution. Put in a Module and run Main.
Excel Formula:
Sub Main()
  Dim ms As Worksheet, ws As Worksheet, a, idR As Range, u, id As Long, calc As Integer
  Dim dR As Range, fR As Range, t, i As Integer
 
  'On Error GoTo EndNow
  With Application
    calc = .Calculation
    .Calculation = xlCalculationManual
    .EnableEvents = False
    .DisplayAlerts = False
    .ScreenUpdating = False
  End With
 
  Set ms = Worksheets(1)
  With ms
    Set dR = .Range("A2", .Cells(.Rows.Count, "H").End(xlUp)) 'data range
    Set idR = .Range("H2", .Cells(.Rows.Count, "H").End(xlUp)) 'IDs range
    u = UniqueValues(idR) 'Unique IDs
  End With
 
  Set ws = Worksheets.Add(, Worksheets(Worksheets.Count), 1)
  For id = 1 To UBound(u)
    'Filter main sheets by unique ID
    ms.UsedRange.AutoFilter Field:=8, Criteria1:=u(id)
    Set fR = dR.SpecialCells(xlCellTypeVisible)
    With ws
      .Cells(id + 1, "A") = u(id) 'ID
      .Cells(id + 1, "B") = fR(1, 5) 'Last
      .Cells(id + 1, "C") = fR(1, 6) 'Last
      t = WorksheetFunction.Index(fR, 0, 2) 'Course Names for ID
      .Cells(id + 1, "D").Resize(, UBound(t)) = WorksheetFunction.Transpose(t)  'Transposed course names by ID
    End With
    ms.AutoFilterMode = False
  Next id
 
  With ws
    'Add Headings
    .[A1] = "ID"
    .[B1] = "Last"
    .[C1] = "First"
    id = .UsedRange.Columns.Count
    ReDim a(1 To id)
    For i = 1 To id
      a(i) = "Course " & i
    Next i
    .[D1].Resize(, id) = a
     
    'Resize ws columns to fit
    .Columns.AutoFit
    'Bold ws row 1
    .Rows(1).Font.Bold = True
  End With
 
EndNow:
  With Application
    .Calculation = calc
    .EnableEvents = True
    .DisplayAlerts = True
    .ScreenUpdating = True
  End With
End Sub

Public Function UniqueValues(theRange As Range, Optional tfVisible = True) As Variant
  Dim colUniques As New VBA.Collection
  Dim vArr As Variant
  Dim vCell As Variant
  Dim vLcell As Variant
  Dim oRng As Excel.Range
  Dim i As Long
  Dim vUnique As Variant
  If tfVisible = False Then
    'Set oRng = Intersect(theRange.SpecialCells(xlCellTypeVisible), theRange.Parent.UsedRange)
    Set oRng = theRange.SpecialCells(xlCellTypeVisible)
    Else
     'Set oRng = Intersect(theRange, theRange.Parent.UsedRange)
     Set oRng = theRange
  End If
  vArr = oRng
  On Error Resume Next
  For Each vCell In vArr
      If Len(CStr(vCell)) > 0 Then
           colUniques.Add vCell, CStr(vCell)
      End If
  vLcell = vCell
  Next vCell
  On Error GoTo 0
 
  ReDim vUnique(1 To colUniques.Count)
  For i = LBound(vUnique) To UBound(vUnique)
    vUnique(i) = colUniques(i)
  Next i
 
  UniqueValues = vUnique
End Function
 
Last edited:
Upvote 0
Solution

Forum statistics

Threads
1,213,536
Messages
6,114,208
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top