How to convert column data into rows, grouped by identifier

  1. 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.

  2. To the right of the first name in your new list (Mine starts at F1, so I have the following in G1), 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:

  1. Sort the list, if not already sorted.
  2. Select the numbers against the first name.
  3. Move to Column C of the first row for the name
  4. Select Edit, Paste Special, Transpose Values, OK
  5. Delete all but the first row for the name
  6. Repeat steps 2 to 5 for all other names
  7. 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