Unique Concatenate Range, multiple rows, Index Match Mutliple Criteria

[snb]

Sub M_snb()
   sn = Sheet1.Cells(1).CurrentRegion
   
   With CreateObject("scripting.dictionary")
      For j = 2 To UBound(sn)
        sp = Array(sn(j, 4), Replace(Trim(Join(Array(sn(j, 5), sn(j, 6), sn(j, 7)))), " ", ", "))
        If .exists(sn(j, 1) & sn(j, 2)) Then
           sq = .Item(sn(j, 1) & sn(j, 2))
           sp = Array(sq(0) & ", " & sp(0), sq(1) & ", " & sp(1))
        End If
        .Item(sn(j, 1) & sn(j, 2)) = sp
      Next
      
       Sheet1.Cells(30, 1).Resize(.Count, 2) = Application.Index(.items, 0, 0)
    End With
End Sub