Split column into multiple columns with row prompt

Rbartlem

Board Regular
Joined
Jun 9, 2004
Messages
172
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...
 

Some videos you may like

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.

sgremmo

Board Regular
Joined
Sep 1, 2004
Messages
55
It's possible that are you looking for something near this?

Code:
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

MrExcel MVP
Joined
Apr 25, 2006
Messages
19,873
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

Code:
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

MrExcel MVP
Joined
Aug 21, 2004
Messages
16,995
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
Code:
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
 

Watch MrExcel Video

Forum statistics

Threads
1,118,807
Messages
5,574,427
Members
412,592
Latest member
moonsugar
Top