Short and split common multicolumn value

Sub DataSort()
Dim Dn As Range, txt As String, Rng As Range
Dim Dic As Object, k As Variant
Dim p As Variant, c As Long
Dim col1 As Integer, col2 As Integer




Set Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
    ReDim Ray(1 To Rng.Count, 1 To 11)
      Set Dic = CreateObject("Scripting.Dictionary")
         Dic.CompareMode = 1
   For Each Dn In Rng
        txt = Dn & "," & Dn.Offset(, 1) & "," & Dn.Offset(, 3).Value & "," & Dn.Offset(, 4).Value & "," & Dn.Offset(, 5).Value
        If Not Dic.exists(txt) Then
                Set Dic(txt) = CreateObject("Scripting.Dictionary")
            End If
        
        If Not Dic(txt).exists(Dn.Offset(, 2).Value) Then
                Dic(txt).Add (Dn.Offset(, 2).Value), Dn
        Else
                Set Dic(txt).Item(Dn.Offset(, 2).Value) = _
                Union(Dic(txt).Item(Dn.Offset(, 2).Value), Dn)
        End If
    Next Dn
  
    c = 2
    Ray(1, 1) = "Date": Ray(1, 2) = "M/C No": Ray(1, 3) = "PO.No": Ray(1, 4) = "Drg No"
    Ray(1, 5) = "Drg Name": Ray(1, 6) = "OPERATOR NAME": Ray(1, 8) = "M/C Time": Ray(1, 9) = "L/UL Time": Ray(1, 10) = "production"
    Ray(2, 6) = "A": Ray(2, 7) = "B": Ray(2, 8) = "Mint.": Ray(2, 9) = "Mint.": Ray(2, 10) = "Shift A": Ray(2, 11) = "Shift B"




    
    For Each k In Dic.Keys
       c = c + 1
       For Each p In Dic(k)
                Ray(c, 1) = Dic(k).Item(p)
                Ray(c, 2) = Dic(k).Item(p).Offset(, 1).Value
                Ray(c, 3) = Dic(k).Item(p).Offset(, 3).Value
                Ray(c, 4) = Dic(k).Item(p).Offset(, 4).Value
                Ray(c, 5) = Dic(k).Item(p).Offset(, 5).Value
                col1 = IIf(p = "A", 6, 7)
                Ray(c, col1) = Dic(k).Item(p).Offset(, 7).Value
                Ray(c, 8) = Dic(k).Item(p).Offset(, 8).Value
                Ray(c, 9) = Dic(k).Item(p).Offset(, 9).Value
                col2 = IIf(p = "A", 10, 11)
                Ray(c, col2) = Dic(k).Item(p).Offset(, 10).Value
        Next p
    Next k
With Sheets("Sheet2").Range("A1").Resize(c, 11)
     .Value = Ray
     .Columns.AutoFit
    .Range("F1:G1").MergeCells = True
    .Range("F1").HorizontalAlignment = xlCenter
    .Range("J1:K1").MergeCells = True
    .Range("J1").HorizontalAlignment = xlCenter
End With
End Sub

Sub DataSort()
 Dim Dn As Range, txt As String, Rng As Range
    Dim Dic As Object, k As Variant, n As Long
    Dim p As Variant, c As Long
    Dim col1 As Integer, col2 As Integer, oSet As Long
     
  With Sheets("Master")
    Set Rng = .Range(.Range("A3"), .Range("A" & Rows.Count).End(xlUp))
  End With
    ReDim ray(1 To Rng.Count, 1 To 57)
    Set Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = 1
    For Each Dn In Rng
        With Application
        txt = Join(.Transpose(.Transpose(Dn.Resize(, 9))), ",")
        End With
        If Not Dic.exists(txt) Then
            Set Dic(txt) = CreateObject("Scripting.Dictionary")
        End If
         
        If Not Dic(txt).exists(Dn.Offset(, 9).Value) Then
            Dic(txt).Add (Dn.Offset(, 9).Value), Dn
        Else
            Set Dic(txt).Item(Dn.Offset(, 9).Value) = _
            Union(Dic(txt).Item(Dn.Offset(, 9).Value), Dn)
        End If
    Next Dn
     
    For Each k In Dic.Keys
        c = c + 1
        For Each p In Dic(k)
           oSet = 10
           For n = 1 To 9
            ray(c, n) = Dic(k).Item(p)(1, n)
          Next n
            For n = 11 To 34
              col1 = IIf(p = "A", oSet, oSet + 1)
              ray(c, col1) = Dic(k).Item(p)(1, n)
              oSet = oSet + 2
            Next n
        Next p
    Next k
    With Sheets("Results").Range("A4").Resize(c, 57)
        .Value = ray
        .Columns.AutoFit
    End With
End Sub