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

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).

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,870
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,113,793
Messages
5,544,315
Members
410,602
Latest member
lidovi
Top