Excel VBA - Loop Transpose

Question

I have a certain range of data. Below are the example data:

PAT   PID 0     Min     3001
PAT   PID 0     Mean    3754
PAT   PID 0     Max     4542
CAT   PID 1            


        

Answer 1

Try this:

Sub test()
      Dim Dic As Object: Set Dic = CreateObject("Scripting.Dictionary")
      Dim CLa As Range, CLb As Range, x&, Names$, ID$, Key
      Dim n As Integer
      Dim trValue() As String


      x = Sheets("Sheet3").Cells(Rows.Count, "A").End(xlUp).Row
      For Each CLa In Sheets("Sheet3").Range("A1:A" & x)
          If Not Dic.exists(CStr(CLa.Value)) Then
              ID = CLa.Value

              For Each CLb In Sheets("Sheet3").Range("A1:A" & x)
                  If CLb.Value = ID Then

                      If Names = "" Then
                          Names = CLb.Offset(, 3).Value
                      Else
                          Names = Names & "," & CLb.Offset(, 3).Value
                      End If

                  End If

              Next CLb

              Dic.Add ID, Names
          End If
      ID = Empty: Names = Empty
      Next CLa

      x = 1
      n = 0
      For Each Key In Dic
          Sheets("Sheet2").Cells(x, 1).Value = Key

          trValue = Split(Dic(Key), ",")
          For n = 0 To UBound(trValue)
              Sheets("Sheet2").Cells(x, n + 2).Value = Trim(trValue(n))
          Next n



          x = x + 1
      Next Key

    Sheets("Sheet2").Cells.Replace "#N/A", Replacement:=""

End Sub