Cutting up a table

[chamster]

I have a table with one column containing 100 entries (i.e. 100 rows). What i'd like to do is to create a macro that
- selects the region
- cuts it up in 4 pieces
- places these pieces next to eachother

By other words i wish to obtain a table from a column.

I don't know the size of the column BUT i can guarantee that it will always add up in the end, i.e. the number of elements in the column is always a product of two known integers.

How should it be done?

[Bob Phillips]

Public Sub ProcessData()
Const TEST_COLUMN As String = "A" '<=== change to suit
Const NUM_COLS As Long = 4 '<=== change to suit
Dim i As Long
Dim iLastRow As Long
Dim mpAdd As Long
Dim mpRows As Long

With ActiveSheet

iLastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
If iLastRow Mod NUM_COLS <> 0 Then _
mpAdd = NUM_COLS - iLastRow Mod NUM_COLS
mpRows = (iLastRow + mpAdd) / NUM_COLS
For i = NUM_COLS - 1 To 1 Step -1
.Cells(mpRows * i + 1, "A").Resize(mpRows).Cut .Cells(1, i + 1)
Next i
End With

End Sub

[p45cal]

Beaten to it by xld again!

The following is an adaptation of the solution at a recent thread:
http://www.vbaexpress.com/forum/showthread.php?t=14540

It requires that you select the single cell at the top of the column to be split and run the macro blah. It takes the range to be split as below the selected cell until a blank cell is encountered. It divides the number of cells in the column by 4 (as near as it can) and splits the column and moves the cells to the columns immediately to the right of the original column, keeping the first column in situ. Anything there will be overwritten.
p45cal
Sub blah()
If Selection.Cells.Count <> 1 Then Exit Sub
TestCol = Selection.Column
Dim RngToSplit As Range
lastrow = Selection.End(xlDown).Row
Set RngToSplit = Range(Selection, Selection.End(xlDown))
mpSplit = Application.WorksheetFunction.RoundUp(RngToSplit.Rows.Count / 4, 0)

'mpSplit = CLng(InputBox("Input split value"))
mycol = Selection.Column
For rw = Selection.Row To lastrow Step mpSplit
If (lastrow - rw) < mpSplit Then 'tests for LAST block to be cut'n'pasted
Range(Cells(rw, TestCol), Cells(lastrow, TestCol)).Cut Range(Cells(Selection.Row, mycol), Cells(Selection.Row, mycol))
Else
Range(Cells(rw, TestCol), Cells(rw + mpSplit - 1, TestCol)).Cut Range(Cells(Selection.Row, mycol), Cells(Selection.Row, mycol))
End If
mycol = mycol + 1
Next rw
End Sub

[chamster]

Thanks. I'll look into that right away.