VBA to Transpose Data

[jrock8859]

Hi,

I would like a VBA that will transpose the data set like this below. I am at a loss of where to start. I am good with VBA for the basic excel functions but I learn by reverse engineering things.

Columns A,B,C is how I am starting, I want to finish with it looking like Columns F and beyond

Tank you

 

[jrock8859]

I added a * to the changed lines in the macro. By the way, jrock8859's macro is quite fast.

Sub TransposeData_1col()
  Dim dic As Object
  Dim a As Variant, b As Variant
  Dim i As Long, n As Long, lr As Long, y As Long
  Dim nrow As Long, ncol As Long
 
  lr = Range("A" & Rows.Count).End(3).Row
  a = Range("A1:B" & lr).Value              '*
  n = Evaluate("=MAX(COUNTIF(A2:A" & lr & ",A2:A" & lr & "))")
  ReDim b(1 To UBound(a, 1), 1 To n + 1)    '*
 
  Set dic = CreateObject("Scripting.Dictionary")
 
  y = 1
  b(1, 1) = a(1, 1)
  For i = 2 To UBound(a, 1)
    If Not dic.exists(a(i, 1)) Then
      y = y + 1
      dic(a(i, 1)) = y & "|" & 2
      b(y, 1) = a(i, 1)
    End If
   
    nrow = Split(dic(a(i, 1)), "|")(0)
    ncol = Split(dic(a(i, 1)), "|")(1)
   
    b(1, ncol) = a(1, 2)
    'b(1, ncol + 1) = a(1, 3)         '*
    b(nrow, ncol) = a(i, 2)
    'b(nrow, ncol + 1) = a(i, 3)      '*
   
    ncol = ncol + 1                   '*
    dic(a(i, 1)) = nrow & "|" & ncol
   
  Next
 
  Range("F1").Resize(y, UBound(b, 2)).Value = b
End Sub

Thank you. This improves my understanding of the functionality of the vba