Split column into multiple columns with row prompt

[Rbartlem]

How can you make a macro to take a column, and split it into multiple columns with a prompt asking how many rows you want it to split at? Basically I have data that takes up 22,000 rows in 1 column, and I need it to only have 500 rows and 44 columns.

does that make sense? I think I saw a macro for this before...

 

[sgremmo]

It's possible that are you looking for something near this?

Sub DataSplit()
'SGinB 20060924
'
'Split activecell column into number of column based on a number of row that user need
'
'DATA
'1
'2
'3
'4
'5
'
'answering 2 data will be split as here:
'
'DATA  split 1 split 2 split 3
'1        1       2        5
'2        3       4
'3
'4
'5
'
'ERROR if activecell isn't on data or is on last cell of data!!!
'
    acrow = ActiveCell.Row
    columndata = ActiveCell.Column
    Selection.End(xlDown).Select
    lastdata = ActiveCell.Row
    Selection.End(xlUp).Select
    firstdata = ActiveCell.Row + 1
    Cells(acrow, columndata).Activate

    hmd = lastdata - firstdata + 1
    
    maxrow = hmd
    mess = "How many rows?" & vbCr & vbCr & "[no more than " & maxrow & "]"

    If hmd >= 256 - columndata Then
        maxrow = Int(hmd / (256 - columndata)) + 1
        mess = "How many rows?" & vbCr & vbCr & "[more than " & maxrow & "]"
    End If
    
    hmr = InputBox(mess)
    
    On Error GoTo error1
    hmr = hmr * 1
   
    On Error GoTo 0
    
    If hmr = 0 Then MsgBox "Can you divide by zero?": Exit Sub
    If hmr < 0 Then MsgBox "No negative...": Exit Sub
    
    If hmr > (hmd) Then MsgBox "In current column I read only " & _
        hmd & " rows of data.": Exit Sub
    
    If Int((hmd) / hmr) = (hmd) / hmr Then
        hmc = (hmd) / hmr
    Else
        hmc = 1 + Int((hmd) / hmr)
    End If
    
    If hmc > 256 - columndata Then MsgBox "I can't need more than 256 column provided by Excel..." & _
        vbCr & vbCr & "With " & hmr & " we need " & hmc & " columns!": Exit Sub
    
    oldStatusBar = Application.DisplayStatusBar
    Application.DisplayStatusBar = True
    Application.ScreenUpdating = False
    
    Columns(ActiveCell.Column + 1).Select
    
    'If there are other data on right of data column and became necessary insert column remove four rem
    'For i = 1 To hmc
    '    Selection.Insert Shift:=xlToRight
    '    Application.StatusBar = "Splitting " & hmc - i & "."
    'Next i
    
    For i = 1 To hmc
        Cells(firstdata - 1, columndata + i).Value = "Split " & i
        Range(Cells(firstdata, columndata + i), Cells(firstdata + hmr - 1, columndata + i)).Value = _
        Range(Cells(firstdata + (hmr * (i - 1)), columndata), Cells(firstdata + (hmr * (i)), columndata)).Value
    Next i
    Cells(acrow, columndata).Activate
    Application.ScreenUpdating = True
    Application.StatusBar = False
    Application.DisplayStatusBar = oldStatusBar
    
Exit Sub
error1:
    MsgBox "Please enter only numbers."
    Exit Sub
End Sub

 

[pgc01]

Hi Rbartlem

Here is another solution. It assumes a simple setup: Your data is in column A, the rest of the sheet is empty.

This code splits column A in chunks of n rows, that are written starting in column B.
As you asked, the code prompts you for the value of n.

Hope this helps
PGC

Sub splitcolumn()
Dim lRows As Long, lMaxRow As Long, l As Long

lMaxRow = Range("A" & Rows.Count).End(xlUp).Row
lRows = InputBox("How many rows/column (>= " & lMaxRow \ (Columns.Count - 2) & ")?")
If lRows < lMaxRow \ (Columns.Count - 2) Then
    MsgBox "Not enough columns in the worksheet. Choose a bigger number of rows/column"
    Exit Sub
End If

Application.ScreenUpdating = False
Do
    Range("A1").Offset(, l + 1).Resize(lRows).Value = Range("A1").Offset(l * lRows).Resize(lRows).Value
    l = l + 1
Loop While l * lRows < lMaxRow
Application.ScreenUpdating = True
End Sub

 

[jindon]

How can you make a macro to take a column, and split it into multiple columns with a prompt asking how many rows you want it to split at? Basically I have data that takes up 22,000 rows in 1 column, and I need it to only have 500 rows and 44 columns.

does that make sense? I think I saw a macro for this before...

Try this one too

Sub test()
Dim a, b(), e, ColNum As Long, RowNum As Long
Dim LastR As Long, n As Long, c As Long
On Error GoTo Last
RowNum = Application.InputBox("Enter number of rows", type:=1)
On Erro GoTo 0
If RowNum < 1 Or RowNum > Rows.Count Then Exit Sub
LastR = Range("a" & Rows.Count).End(xlUp).Row
ColNum= WorksheetFunction.RoundUp(LastR / RowNum,0)
If ColNum > Columns.Count Then
   MsgBox "Need more rows"
   Exit Sub
End If
ReDim b(1 To RowNum, 1 To ColNum)
With Range("a1",Range("a" & Rows.Count).End(xlUp))
   a = .Value
   .ClearContents
End With
c = 1
For Each e In a
   n = n + 1
   If n > RowNum Then n = 1 : c = c + 1
   b(n,c) = e
Next
Range("a1").Resize(RowNum,ColNum).Value = b
Last:
End Sub