Modify VBA to get rid Duplicated String when Transpose-Index/Score & String associated to.

Hi,
I'm wondering if someone help me to modify the following Code?
My workbook have two sheets "Records" and "Ouput",
On Column A2:A37 The sheet Records has Alphanumeric String and
on Column B2:B37 Has Scores (Alphanumeic as well)
Note that some String from Col A and Scores Col B are duplicated
what the code do:
it get the Scores (Col B2:B37) and copy as unique score on Sheet Output Col M1:M17
Then extract any String associated to each Score and copy next to it on same sheet Ouput Col O1:V17

NOTE 1: I need to Paste but starting on Row M2 of Ouput?, is pasting in Row M1, and i can't find where to change it

NOTE2: The code is working find but on Range N1:V17 is copying unwanted Duplicated String on Single Score Row, It does'nt matter if any other string appear multiples Times on Multiples Scores But Just once (per row).

See bellow The Ouput with Unwanted Duplicated String that i need to get rid of (red string).


Score ID __STRING
40 -----> 15
20 -----> 18 18
17 -----> 03 10 06 07
13 -----> 23 23 23
12 -----> 14 16 30
11 -----> 05 12
9 ------> 32
8 ------> 23
3 ------> 34 29 34 29
5 ------> 09 01
4 ------> 21 11
2 ------> 17 20
1 ------> 33 26 08 04
0 ------> 02 13 36 28

The Ouput what i need with Unique String that belong to each score
===========================================
Score ID___STRING
40 -----> 15
20 -----> 18
17 -----> 03 10 06 07
13 -----> 23
12 -----> 14 16 30
11 -----> 05 12
9 ------> 32
8 ------> 23
3 ------> 34 29
5 ------> 09 01
4 ------> 21 11
2 ------> 17 20
1 ------> 33 26 08 04
0 ------> 02 13 36 28




Im using this code
============

Sub MG28Sep00() 'Private Sub CommandButton1_Click)
Dim Rng As Range, Dn As Range, n As Long
Dim Dic As Object, Q As Variant, K As Variant, c As Long
With Sheets("records")
Set Rng = .Range(.Range("B2:B37"), .Range("B" & Rows.Count).End(xlUp).Offset(1))
End With
Set Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
For Each Dn In Rng
If Not Dic.Exists(Dn.Value) Then
    ReDim ray(1 To Rng.Count)
    ray(1) = Dn.Offset(, -1) 'WAS -1
    Dic.Add Dn.Value, Array(ray, 1)
Else
    Q = Dic.Item(Dn.Value)
        Q(1) = Q(1) + 1 'WAS +1
    Q(0)(Q(1)) = Dn.Offset(, -1).Value 'WAS -1
  Dic.Item(Dn.Value) = Q
End If
Next

For Each K In Dic.keys
    With Sheets("output")
        c = c + 1 'WAS +2 Here control empty Row Down between, example If Set +2, display 1 row w data other empty, with +1 no empty rows
        .Cells(c, "M") = K
        .Cells(c, "N").Resize(, Dic.Item(K)(1)) = Dic.Item(K)(0)
    End With
Next K
End Sub

Thanks a Millions !!!!