Move specific rows to columns

Copper Contributor

I'm a novice in excel and would appreciate some help. I have data that comes from Qualtrics and I would like to put it into a better format. Each Assessor (Column A) marks up to 9 students, those details (student name, marks, comments = 10 columns per student) come in one row only of 9 students per assessor. I need the student details to fall under each other. See before and after below.

The assessor name and location would always be columns A and B, I then want all student details in columns C > L. I can do it via cutting and pasting, is there a better way? Thank you.

BEFORE

Assessor - Selected ChoiceCampusStudent (1) NameC - Part 1C - Part 2C - A to QComms.C - SP GradeGlobal RatingGradeCommentsIssuesStudent (2) NameC - Part 1C - Part 2C - A to QComms.C - SP GradeGlobal RatingGradeCommentsIssuesStudent (3) Name
JONES, TomWollongongStudent 1554446comments Student 6444445comments Student 11
DARK, RobWollongongStudent 2443445comments Student 7444556Ecomments Student 12
FROMEL, JohnNowraStudent 3444445comments Student 8444445comments Student 13
STYLES, HarryWollongongStudent 4445334comments Student 9334444comments Student 14
DOE, JaneNowraStudent 5321333comments Student 10443445comments Student 15

AFTER

Assessor - Selected ChoiceCampusStudent NameC - Part 1C - Part 2C - A to QComms.C - SP GradeGlobal RatingGradeCommentsIssues
JONES,TomWollongongStudent 1554446comment 
JONES,TomWollongongStudent 6444445comment 
JONES,TomWollongongStudent 11423444Scomment 
DOE, JaneNowraStudent 5555557Ecomment 
DOE, JaneNowraStudent 10554556comment 
DOE, JaneNowraStudent 15443445comment 

 

 

1 Reply

@krodgers0000 

This is probably best done using Power Query, but I'll leave that to others. Here is a macro solution:

Sub ConvertData()
    Dim wss As Worksheet
    Dim wst As Worksheet
    Dim s As Long
    Dim m As Long
    Dim c As Long
    Dim n As Long
    Dim t As Long
    Application.ScreenUpdating = False
    Set wss = ActiveSheet
    Set wst = Worksheets.Add(After:=wss)
    wst.Range("A1:L1").Value = wss.Range("A1:L1").Value
    wst.Range("C1").Value = "Student Name"
    t = 1
    m = wss.Cells(wss.Rows.Count, 1).End(xlUp).Row
    For s = 2 To m
        n = wss.Cells(s, wss.Columns.Count).End(xlToLeft).Column
        For c = 3 To n Step 10
            t = t + 1
            wst.Cells(t, 1).Resize(1, 2).Value = wss.Cells(s, 1).Resize(1, 2).Value
            wst.Cells(t, 3).Resize(1, 10).Value = wss.Cells(s, c).Resize(1, 10).Value
        Next c
    Next s
    Application.ScreenUpdating = True
End Sub