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...
 

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().

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,887
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
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,167,834
Messages
5,855,898
Members
431,772
Latest member
dannyboi1

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top