VBA to Transpose Rows to Columns

BoyBoy

New Member
Joined
Sep 25, 2020
Messages
26
Office Version
  1. 365
Platform
  1. Windows
Hi,
I need a vba code to rearrange (transpose) my data
from the following in sheet 1
1601016797022.png

to the following in sheet 2
1601016983766.png

My column A (Class Name) has more than 10,000 rows.
A working code would be greatly appreciated.

Boyboy
 

BoyBoy

New Member
Joined
Sep 25, 2020
Messages
26
Office Version
  1. 365
Platform
  1. Windows
Another VBA solution:
Sorting of classes and students done.

VBA Code:
Sub StudentTranspose()
Dim dataread, datawrite(), cls()
Dim lr As Long, c As Long, lc As Long
Dim i As Long, j As Long, n As Long
Dim unq As Boolean
With Worksheets("Sheet1")
    lr = .Cells(.Rows.Count, "A").End(xlUp).Row
    .Range("A1:B" & lr).Sort key1:=.Range("A1"), Order1:=xlAscending, _
        key2:=.Range("B1"), Order2:=xlAscending, Header:=xlYes
    dataread = .Range("A1:B" & lr)
End With
ReDim cls(1 To 26, 1 To 2) 'A to Z
cls(1, 1) = dataread(2, 1) 'first class
cls(1, 2) = 1 'counter
c = 1
For i = 3 To lr
    unq = True
    For j = 1 To c
        If cls(j, 1) = dataread(i, 1) Then
            unq = False
            cls(j, 2) = cls(j, 2) + 1
            If lc < cls(j, 2) Then lc = cls(j, 2)
            Exit For
        End If
    Next j
    If unq Then
        c = c + 1
        cls(c, 1) = dataread(i, 1)
    End If
Next i
ReDim datawrite(1 To c + 2, 1 To lc + 2)
datawrite(1, 1) = dataread(1, 1)
For n = 2 To c + 1 'fill Class Names
    datawrite(n, 1) = cls(n - 1, 1)
    cls(n - 1, 2) = 1 'reset
Next n
For n = 1 To lc 'fill student name headers
    datawrite(1, n + 1) = "Student" & n
Next n
datawrite(2, 2) = dataread(2, 2)
For i = 3 To lr 'read counter
    For j = 1 To c
        If cls(j, 1) = dataread(i, 1) Then
            datawrite(j + 1, cls(j, 2) + 1) = dataread(i, 2)
            cls(j, 2) = cls(j, 2) + 1
        End If
    Next j
Next i
Worksheets("Sheet2").Range("A1").Resize(c + 1, lc) = datawrite
End Sub
Thank you so much!
 

Some videos you may like

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.

Watch MrExcel Video

Forum statistics

Threads
1,114,421
Messages
5,547,824
Members
410,813
Latest member
Vhinzvirgo
Top