When I’m not fighting the war on bad call centers I try to assist my better half with some of her work.  Lately this has involved a lot of spreadsheets and data manipulation, which is something I enjoy as it’s a bit different than what I do day-to-day. The latest issue was turning a dataset from rows to columns. Transpose, you say? I wouldn’t be posting this if it would have been that easy.  The dataset looked like this:

A 7 2 9
B 3 4 5
A 9 9 2
C 3 2 3
C 1 3 9
B 1 2 2
…

The good thing is that the data had the same number or rows for every entity, in my case 10 rows belonged to each entity.  The bad news is that transposing got me from 10 rows to 10 columns.  The first thing I did was sort the rows by entity to group all entity rows together and did a transpose. 

AABBCC
793131
224223
925239
…

Next, I went to Google for some help and came up with the following macro:

Sub ManyColumnsTo1()
Dim LR As Long, index1 As Long, index2 As Long, x As Long, y As Long, z As Long, maxCol As Long
x = 2
y = 10
z = 1
maxCol = 50
‘ First entry
    For index1 = x To y
        LR = Cells(Rows.Count, index1).End(xlUp).Row
        Range(Cells(1, index1), Cells(LR, index1)).Copy
        Cells(Rows.Count, z).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
    Next index1
‘ All others
For index2 = x To maxCol
    x = x + 10
    y = y + 10
    z = z + 10
    For index1 = x To y
        LR = Cells(Rows.Count, index1).End(xlUp).Row
        Range(Cells(1, index1), Cells(LR, index1)).Copy
        Cells(Rows.Count, z).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
    Next index1
Next index2
On Error Resume Next
Columns("A").SpecialCells(xlCellTypeBlanks).Delete shift:=xlShiftUp
On Error GoTo 0
End Sub

This macro will copy a range of columns into one column.  The code will copy y columns, starting with column x into column z.  The for loop will then cycle through maxCol to ensure you get every column in your dataset. Which then gives us the following.

AABBCC
793131
224223
925239
A  B  C
9  1  1
2  2  3
2  2  9
…

Ultimately, this is what I wanted, but I had a lot of unnecessary columns in the middle which we needed to get rid of.  Enter a column delete macro:

Sub DeleteColumn()
    Dim startCol As Long, endCol As Long, maxCol As Long
    startCol = 1
    endCol = 10
    maxCol = 50
    For i = startCol To maxCol
        ActiveSheet.Range(Cells(1, startCol + 1), Cells(10, endCol)).EntireColumn.Delete
        startCol = startCol + 1
        endCol = endCol + 1
    Next i
End Sub

This macro will delete a range of columns.  The deletion will start with startCol through endCol for maxCol.

Which gives us the following.

ABC
733
242
953
ABC
911
223
229
…

One more transpose and some cleanup and we’re good to go.  Hope this helps others.

david