Question

I have Excel data that looks like the top two rows of the following:

I need to get it looking like the data on the bottom rows.

Answer 1

A very easy way of doing this is by using the transpose option of Paste Special, depending on how much data you have. For a small amount it’s worth doing it this way.

1. Select B1:E1
2. Copy.
3. Select where you want it pasted.
4. Go to Edit, Paste Special and choose transpose
5. It will now be shown vertically. Just fill in the name Joe Bloggs and fill it down.

If you have a lot of different people, Joe Bloggs, Jane Doe and many more it would be a chore to transpose each individual person so a quick bit of VB code like horrible thing below should do the trick.

Public Sub test()
    Dim rowFound As Boolean, columnFound As Boolean, y As Long, x As Long, rowCounter As Long
    Dim thisSheet As Excel.Worksheet, resultSheet As Excel.Worksheet
    Set thisSheet = ActiveWorkbook.Sheets("Sheet1")
    Set resultSheet = ActiveWorkbook.Sheets("Sheet2")
    rowFound = True
    y = 0
    rowCounter = 0
    Do While rowFound
        columnFound = True
        Dim foundName As String
        foundName = thisSheet.Range("A1").Offset(y).Value
        If foundName = "" Then
            rowFound = False
        Else
            x = 0
            Do While columnFound
                If thisSheet.Range("B1").Offset(y, x).Value = "" Then
                    columnFound = False
                Else
                    resultSheet.Range("A1").Offset(rowCounter).Value = foundName
                    resultSheet.Range("B1").Offset(rowCounter).Value = thisSheet.Range("B1").Offset(y, x).Value
                    rowCounter = rowCounter + 1
                End If
                x = x + 1
            Loop
        End If
        y = y + 1
    Loop
End Sub

x and y are used like a set of graph coordinates. For every row it scans through the columns in the row, and adds it to the list below.

Edit:
I’ve updated the code, Integers are now Long and it writes the results to sheet2.