Adding line break and alpha-sort to existing VBA

[mikec82]

I have a table that looks like this:

Teacher	Class
Mark Smith	English
Mark Smith	Math
David Park	Science
David Park	History

<tbody>
</tbody>

I currently have a VBA solution (at the bottom) that combines teachers to one row, and lists their classes in the next, separated by commas. Here is what the above example would look like:

Teacher	Class
Mark Smith	English, Math
David Park	Science, History

<tbody>
</tbody>

This is working well, but there are two things I would like to see if it is possible to add:

1) Rather than classes separated by commas, it would be helpful to have a line break:

Teacher	Class
Mark Smith	English Math
David Park	Science History

<tbody>
</tbody>

2) Alphabetize the classes. So History would come before Science in the example above.

Any help on this would be much appreciated.


Public Sub TeacherClass()
Dim d As Object, _
k As Variant, _
rowx As Long


Dim i As Long, _
LR As Long

Dim sWS As Worksheet, _
dWS As Worksheet

Set d = CreateObject("scripting.dictionary")


Set sWS = ActiveSheet
Set dWS = Sheets.Add


LR = sWS.Range("A" & Rows.Count).End(xlUp).Row


For i = 2 To LR
With sWS
If Not d.Exists(.Range("A" & i).Value) Then
'Add to list
d.Add .Range("A" & i).Value, .Range("B" & i).Value
Else
'Append
d(.Range("A" & i).Value) = d(.Range("A" & i).Value) & ", " & .Range("B" & i).Value
End If
End With
Next i


rowx = 2


dWS.Range("A1").Value = "Student"
dWS.Range("B1").Value = "Block"


For Each k In d.Keys
dWS.Range("A" & rowx).Value = k
dWS.Range("B" & rowx).Value = d(k)
rowx = rowx + 1
Next k


End Sub