auto convert unique row data to columns

Hi

Pretty crude, but should get you there.

Sub aaa()
  For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
    outcol = WorksheetFunction.Max(7, Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).Column)
    If WorksheetFunction.CountIf(Range("a2").Resize(i, 1), Cells(i, 1).Value) = 1 Then
      Cells(1, outcol).Value = Cells(i, 1).Value
    End If
  Next i

  For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
    outcol = WorksheetFunction.Match(Cells(i, 1), Rows("1:1"), 0)
    If WorksheetFunction.CountIf(Cells(1, outcol).EntireColumn, Cells(i, 2)) = 0 Then
      Cells(Rows.Count, outcol).End(xlUp).Offset(1, 0).Value = Cells(i, 2)
    End If
  
  Next i
End Sub

rylo

Thanks.
I have marked the thread solved and added to the answerer's reputation but if there is a better solution please post it because I do not know why exactly is this solution "crude".