Wrap rows that have duplicates

I've got data that looks like this:

BOB  | 4
BOB  | 3
BOB  | 7
MARY | 1
JOE  | 2
JOE  | 1
MIKE | 6

I want to end up with data that looks like this:

BOB  | 4 | 3 | 7
MARY | 1 |   |
JOE  | 2 | 1 |
MIKE | 6 |   |

The problem is, how do I account for the variable number of times a n开发者_运维问答ame shows up?

I came up with the following code. It feels like it could be cleaner.

This will work for any selected block of data on your sheet (assuming it is pre-sorted). It outputs on the same sheet in the same area.

Sub WrapDuplicates()
    Dim data(), i As Long, startCell As Range, rwCnt As Long, col As Long

    data = Selection //pull selected data into an array
    Set startCell = Selection.Cells(1, 1) //Get reference to write results to
    Selection.ClearContents //remove original data
    startCell = data(1, 1) //Output first name
    startCell.Offset(0, 1) = data(1, 2) //Output first value

    rwCnt = 0
    col = 2

    For i = 2 To UBound(data) //Loop through array and check if name is same or not and output accordingly
        If data(i, 1) = data(i - 1, 1) Then
            startCell.Offset(rwCnt, col) = data(i, 2)
            col = col + 1
        Else
            rwCnt = rwCnt + 1
            col = 2
            startCell.Offset(rwCnt, 0) = data(i, 1)
            startCell.Offset(rwCnt, 1) = data(i, 2)
        End If
    Next i
End Sub

I'm assuming you want to do this in code based on the excel-vba tag in your post.

I'm also assuming the data is sorted by name, or you are OK with sorting it by name before the code executes.

Source is in sheet 1, target is in sheet 2. Code is in Excel VBA. I tested with your sample data, dropping this subroutine in the ThisWorkbook section of the Excel codebehind and pressing play.

The target header gets rewritten every time, which isn't ideal from a performance perspective, but I don't think is a problem otherwise. You could wrap it in an if statement that checks the target column index = 2 if it becomes a problem.

Sub ColumnsToRows()

Dim rowHeading
Dim previousRowHeading
Dim sourceRowIndex
Dim targetRowIndex
Dim targetColumnIndex


sourceRowIndex = 1
targetRowIndex = 1
targetColumnIndex = 2

rowHeading = Sheet1.Cells(sourceRowIndex, 1)
previousRowHeading = rowHeading

While Not rowHeading = ""

    If Not previousRowHeading = rowHeading Then
        targetRowIndex = targetRowIndex + 1
        targetColumnIndex = 2
    End If

    Sheet2.Cells(targetRowIndex, 1) = rowHeading
    Sheet2.Cells(targetRowIndex, targetColumnIndex) = Sheet1.Cells(sourceRowIndex, 2)
    previousRowHeading = rowHeading

    sourceRowIndex = sourceRowIndex + 1
    targetColumnIndex = targetColumnIndex + 1
    rowHeading = Sheet1.Cells(sourceRowIndex, 1)

Wend

End Sub

I'm a developer, not an Excel guru. There may be some Excel function, pivot table, or some other Excel magic that does this for you automatically.