How to convert column data into rows, grouped by identifier
Make list of all unique entries from Column
A
. In this sample, it would be a matter of typing two names. With a larger data set you could copy that column to your target location and just use the Remove Duplicates tool to pare down the list.-
To the right of the first name in your new list (Mine starts at
F1
, so I have the following inG1
), enter the following formula as an array formula by pressing Ctrl+Shift+Enter:=IFERROR(INDEX($B$1:$B$18,SMALL(IF($A$1:$A$18=$F1,ROW($B$1:$B$18),""),COLUMN()-COLUMN($F1))),"")
For reference, A1:A18
is your original list of Names, B1:B18
is their corresponding numbers, and F1
is the name "Baker" in your new table. Fill this over to the right as far as you like. Then, fill down to complete your table.
NOTE: If your original data does NOT start on Row 1
, then use the following formula instead, where A1
is the top-left cell of your original data:
=IFERROR(INDEX($B$1:$B$18,SMALL(IF($A$1:$A$18=$F1,ROW($B$1:$B$18)-ROW($A$1)+1,""),COLUMN()-COLUMN($F1))),"")
If there are only a few names, you could do the following from the keyboard:
- Sort the list, if not already sorted.
- Select the numbers against the first name.
- Move to Column C of the first row for the name
- Select Edit, Paste Special, Transpose Values, OK
- Delete all but the first row for the name
- Repeat steps 2 to 5 for all other names
- Delete column B.
If you have lots of names, you will need a VBA solution:
Option Explicit
Sub TransposeColB()
Dim ColCrntNext As Integer ' The next cell on the current row
Dim ColNextLast As Integer ' The last cell on the next row
Dim Offset As Integer ' Offset from first number on row to last
Dim RowCrnt As Integer ' Current row
With Sheets("Sheet1") ' !!!! Replace "Sheet1" with name of your sheet !!!!
' Sort entire sheet in case a partial tranpose has occurred.
.Cells.Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
RowCrnt = 1
' Identify first blank cell on row. This ensures nothing is overwritten.
ColCrntNext = .Cells(RowCrnt, Columns.Count).End(xlToLeft).Column + 1
Do While True
' Check name on next row
Select Case .Cells(RowCrnt + 1, "a").Value
Case ""
' The next row has no name. The transpose is complete.
Exit Do
Case .Cells(RowCrnt, "a").Value
' The next row has the same name as the current row. Move its
' numbers to the current row.
' Find last used column on the next row
ColNextLast = .Cells(RowCrnt + 1, _
Columns.Count).End(xlToLeft).Column
Offset = ColNextLast - 2 ' Offset from first number to last.
' Normally zero.
' Move numbers from next row to current
.Range(.Cells(RowCrnt, ColCrntNext), _
.Cells(RowCrnt, ColCrntNext + Offset)).Value = _
.Range(.Cells(RowCrnt + 1, 2), _
.Cells(RowCrnt + 1, 2 + Offset)).Value
.Rows(RowCrnt + 1).EntireRow.Delete ' Delete next row
ColCrntNext = ColCrntNext + Offset + 1 ' Advance to first blank cell
Case Else
' The next row is for a new name
RowCrnt = RowCrnt + 1
' Identify first blank cell on row. This ensures
' nothing is overwritten.
ColCrntNext = .Cells(RowCrnt, _
Columns.Count).End(xlToLeft).Column + 1
End Select
Loop
End With
End Sub