Not as compact as I still imagine is possible, but here is working code
(until I can find a more compact version)...

Sub AlignColumnData()
Dim X As Long, Lngth As Long, Data As Variant, Cell As Range
Data = WorksheetFunction.Transpose(Range("B1:B" & Cells(Rows.Count,
"B").End(xlUp).Row))
With Range("B1:B" & Cells(Rows.Count, "B").End(xlUp).Row)
.Copy Cells(Rows.Count, "A").End(xlUp).Offset(1)
.Clear
End With
Columns("A").Sort Range("A1"), xlAscending
For X = 2 To Cells(Rows.Count, "A").End(xlUp).Row
With Cells(X, "A")
If .Value = Cells(X - 1, "A").Value Then
.Offset(-1, 1).Value = Cells(X, "A").Value
.Clear
End If
End With
Next
Columns("A").SpecialCells(xlCellTypeBlanks).Entire Row.Delete
For X = LBound(Data) To UBound(Data)
With Columns("A").Find(Data(X), LookAt:=xlWhole)
Lngth = Len(.Offset(0, 1).Value)
If Lngth = 0 Then
.Copy .Offset(0, 1)
.Clear
End If
End With
Next
End Sub

Rick Rothstein (MVP - Excel)