Sorry, had a brain-phhhhtt! I believe you can do it with this code.
Sub MakeHeaders()
'assumes on proper sheet when you start
'set up for sorted data starting at A2
'headers to start at B1
Const FirstDataItem = "A2" ' change as needed
Const FirstHeaderEntry = "B1" ' change as needed
Dim LastHeader As String
Dim RowOffset As Integer
Dim ColumnOffset As Integer
Range(FirstHeaderEntry) = Range(FirstDataItem)
LastHeader = Range(FirstDataItem).Value
ColumnOffset = 1
RowOffset = 1
Do Until IsEmpty(Range(FirstDataItem).Offset(RowOffset, 0))
If Range(FirstDataItem).Offset(RowOffset, 0) <> LastHeader Then
'entries have changed copy it and update pointers
LastHeader = Range(FirstDataItem).Offset(RowOffset, 0)
Range(FirstHeaderEntry).Offset(0, ColumnOffset).Value = LastHeader
ColumnOffset = ColumnOffset + 1
End If
RowOffset = RowOffset + 1
Loop
End Sub
use [Alt]+[F11] to open up the VB Editor, use Insert | Module to start a
code module and cut and paste this code into it. Make changes to the two
starting cell addresses as needed. Choose the sheet, sort your data, run the
macro.