Move specific rows to columns

Question

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 Choice	Campus	Student (1) Name	C - Part 1	C - Part 2	C - A to Q	Comms.	C - SP Grade	Global Rating	Grade	Comments	Issues	Student (2) Name	C - Part 1	C - Part 2	C - A to Q	Comms.	C - SP Grade	Global Rating	Grade	Comments	Issues	Student (3) Name
JONES, Tom	Wollongong	Student 1	5	5	4	4	4	6	E	comments		Student 6	4	4	4	4	4	5	S	comments		Student 11
DARK, Rob	Wollongong	Student 2	4	4	3	4	4	5	S	comments		Student 7	4	4	4	5	5	6	E	comments		Student 12
FROMEL, John	Nowra	Student 3	4	4	4	4	4	5	S	comments		Student 8	4	4	4	4	4	5	S	comments		Student 13
STYLES, Harry	Wollongong	Student 4	4	4	5	3	3	4	S	comments		Student 9	3	3	4	4	4	4	S	comments		Student 14
DOE, Jane	Nowra	Student 5	3	2	1	3	3	3	U	comments		Student 10	4	4	3	4	4	5	S	comments		Student 15

AFTER

Assessor - Selected Choice	Campus	Student Name	C - Part 1	C - Part 2	C - A to Q	Comms.	C - SP Grade	Global Rating	Grade	Comments	Issues
JONES,Tom	Wollongong	Student 1	5	5	4	4	4	6	E	comment
JONES,Tom	Wollongong	Student 6	4	4	4	4	4	5	S	comment
JONES,Tom	Wollongong	Student 11	4	2	3	4	4	4	S	comment
DOE, Jane	Nowra	Student 5	5	5	5	5	5	7	E	comment
DOE, Jane	Nowra	Student 10	5	5	4	5	5	6	E	comment
DOE, Jane	Nowra	Student 15	4	4	3	4	4	5	S	comment

hansvogelaar · Answer

krodgers0000&nbsp;
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

Forum Discussion

Move specific rows to columns

1 Reply

Resources