Consolidate and transpose table (using VBA)

[scottwsms]

Hi all, first time poster, rather new to all things vba. I have a dataset that i need to clean up and i'm certain i can automate this task using VBA, but was hoping for your help on the second part.

Essentially i have a survey where students select the teacher they had, fill in a few questions using a 1-5 scale and then the final question is open ended responses. This means i end up with multiple entries for each teacher - my job is to consolidate the data such that i have one record of each teacher, with an average of each scaled response, and then a column for each of the open ended responses. The open ended responses are optional so there may only be one, but there may be up to ten. I begin by sorting my data based upon teacher name and then consolidating the table.
I am able to consolidate the raw data and scaled responses with the following vba code. Note this was just ran using record macro to get the general idea - the final data source would be contained within a table:

Sub Consolidate()

Application.CutCopyMode = False
Selection.Consolidate Sources:="[Book1]Sheet1!R1C1:R26C5", Function:= _
xlAverage, TopRow:=True, LeftColumn:=True, CreateLinks:=False
End Sub

However i cannot figure out how to transpose the open ended responses into subsequent columns. Any help would be appreciated. For reference, i have pasted an image of sample raw data i would receive and how i want it to look when finished:

Raw data:

End product:

Thanks!

 

[DanteAmor]

Hi and welcome to MrExcel.

Your raw data on Sheet1, the results on Sheet2
Try this:

Sub Consolidate_transpose()
  Dim a As Variant, b As Variant
  Dim i As Long, f As Long, c As Long, n As Long
  Dim dic As Object, ky As Variant
  
  a = Sheets("Sheet1").Range("A2:E" & Sheets("Sheet1").Range("A" & Rows.Count).End(3).Row).Value
  ReDim b(1 To UBound(a, 1), 1 To UBound(a, 1))
  Set dic = CreateObject("Scripting.Dictionary")
  
  For i = 1 To UBound(a, 1)
    If Not dic.exists(a(i, 1)) Then
      f = f + 1
      c = IIf(a(i, 5) <> "", 5, 4)
      n = 1
      b(f, 1) = a(i, 1)
    Else
      f = Split(dic(a(i, 1)), "|")(0)
      c = Split(dic(a(i, 1)), "|")(1) + IIf(a(i, 5) <> "", 1, 0)
      n = Split(dic(a(i, 1)), "|")(2) + 1
    End If
    dic(a(i, 1)) = f & "|" & c & "|" & n
    b(f, 2) = b(f, 2) + a(i, 2)
    b(f, 3) = b(f, 3) + a(i, 3)
    b(f, 4) = b(f, 4) + a(i, 4)
    If a(i, 5) <> "" Then b(f, c) = a(i, 5)
  Next
  
  For Each ky In dic.keys
    f = Split(dic(ky), "|")(0)
    n = Split(dic(ky), "|")(2)
    b(f, 2) = b(f, 2) / n
    b(f, 3) = b(f, 3) / n
    b(f, 4) = b(f, 4) / n
  Next
  
  Sheets("Sheet2").Range("A2").Resize(dic.Count, UBound(b, 2)).Value = b
End Sub