Help! Consolidating rows across columns with duplicate names!

[joshuastevenmiller]

Hey, I've tried to look through the forum and see if this has been asked, I haven't found anything quite like what I'm looking for -

Basically, I have information from a school. Column A is school ID, column B is a students name. Columns C through I have information regarding a particular class for that student. This information is going to generate letters in Microsoft Word regarding truancy. The issue I'm having is that while row 1 might be for student Doe, John and row 2 might be Doe, Jane, row three and four might also be Doe, Jane - but with separate information in the C through I columns, because she has missed multiple classes. So, my goal would be to consolidate the extra rows and push them to new columns in the same row - one row per name.

doe, john period teacher absent
doe, jane period teacher absent [period2] [teacher2] [absent2]
doe, jane period2 teacher2 absent2

I'm trying to move the third row to the row in brackets. I feel like this was really confusing so I apologize in advance. Thanks for whatever help you can provide!

 

[JoeMo]

Lightly tested - try this on a copy of your worksheet. Please be sure your data layout complies with the assumptions stated in the comment line at the start of the sub.

Sub ConsolidateSchoolInfo()
'assumes row 1 is headers, student names start in cell B2,ID in cell A2, 5 columns (A:E) total for raw data
Dim R As Range, V As Variant, MaxCols As Long, i As Long, add As Long, j As Long
Dim Rw As Range, delRw As Range
Set R = Range("A1").CurrentRegion
MaxCols = 3 * R.Columns(2).Cells.Count
Set R = R.Offset(1).Resize(R.Rows.Count - 1, MaxCols)
V = R.Value
For i = UBound(V, 1) To 2 Step -1
    If V(i, 2) = V(i - 1, 2) Then
        For j = 6 To MaxCols
            V(i - 1, j) = V(i, j - 3)
        Next j
        For j = 1 To MaxCols
            V(i, j) = ""
        Next j
    End If
Next i
Application.ScreenUpdating = False
R.Value = V
For Each Rw In R.Rows
    If Application.CountA(Rw) = 0 Then
        If delRw Is Nothing Then
            Set delRw = Rw
        Else
            Set delRw = Union(Rw, delRw)
        End If
    End If
Next Rw
On Error Resume Next
delRw.EntireRow.Delete
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

 

[joshuastevenmiller]

JoeMoe - Thank you so much for taking your time to write that. I have to say, though, that I'm so out of my depth with your code - where do I even put this? Do I just copy it into the worksheet, or is there a special way to run code like this? Ha, I'm sorry for my ignorance, and thank you again!

 

[JoeMo]

JoeMoe - Thank you so much for taking your time to write that. I have to say, though, that I'm so out of my depth with your code - where do I even put this? Do I just copy it into the worksheet, or is there a special way to run code like this? Ha, I'm sorry for my ignorance, and thank you again!

You are welcome. Follow the steps below to install and run the code.
To install standard module code:
1. With your workbook active press Alt and F11 keys. This will open the VBE window.
2. In the project tree on the left of the VBE window, find your project and click on it.
3. On the VBE menu: Insert>Module
4. Copy the code from your browser window and paste it into the white space in the VBE window.
5. Close the VBE window and Save the workbook. If you are using Excel 2007 or a later version do a SaveAs and save it as a macro-enabled workbook (.xlsm file extension).
6. Press Alt+F8 keys to run the code
7. Make sure you have enabled macros whenever you open the file or the code will not run.