Split Range into Multiple Columns VBA

**Admin** · 12-22-2011, 01:33 AM

Hi All,

Here is a sub to split a range into multiple columns.

Code:

Option Explicit

Sub SplitRangeIntoMultipleCols()

    Dim varData, varArrOutput(), rngSource As Range
    Dim j As Long, m As Long, i As Long, n As Long, c As Long
    Dim wksResult   As Worksheet
    
    Set rngSource = Application.InputBox(prompt:="Select the range to convert", Title:="ExcelFox.com", Type:=8)

    If Not rngSource Is Nothing Then
        c = Application.InputBox("How many columns maximum do you want?", Title:="ExcelFox.com", Type:=1)
        If c > 0 Then
            varData = rngSource
            If IsArray(varData) Then
                j = UBound(varData, 1) \ c
                If j * c <> UBound(varData, 1) Then j = j + 1
                ReDim varArrOutput(1 To j, 1 To c * UBound(varData, 2))
                c = 1
                For i = 1 To UBound(varData, 1)
                    n = n + 1
                    For m = 1 To UBound(varData, 2)
                        varArrOutput(n, c + m - 1) = varData(i, m)
                    Next
                    If i Mod j = 0 Then c = c + m - 1: n = 0
                Next
                Application.ScreenUpdating = False
                Set wksResult = Worksheets.Add: wksResult.Name = "Result_"
                wksResult.Range("a2").Resize(j, UBound(varArrOutput, 2)) = varArrOutput
            End If
        End If
    End If
                    
    Application.ScreenUpdating = True
                    
End Sub

**Rick Rothstein** · 03-07-2012, 03:18 PM

There seem to be situations where this code does not work correctly... actually, I should say, cannot work correctly. Select a single column of 20 cells and specify you want 8 columns made from it... you will/can only get 7 columns as long as you insist that each column should have the same number of rows in it (with the last column possibly having less). Perhaps the "How many columns do you want?" question should be changed to "How many columns maximum do you want?"...

**Admin** · 03-07-2012, 06:06 PM

Code edited. Thanks again Rick

**Rick Rothstein** · 03-07-2012, 10:53 PM

Originally Posted by Admin

Code edited. Thanks again Rick

And again, you are quite welcome. Just in case readers of this thread might be interested, here is a shorter piece of code (uses a different approach) that appears to do what your code does...

Code:

Sub SplitRangeIntoMultipleCols_Rick()
    Dim X As Long, R As Long, C As Long, Cols As Long, rngSource As Range, wksResult As Worksheet
    Set rngSource = Application.InputBox(prompt:="Select the range to convert", Title:="ExcelFox.com", Type:=8)
    If Not rngSource Is Nothing Then
        Cols = Application.InputBox("How many columns maximum do you want?", Title:="ExcelFox.com", Type:=1)
        If Cols > 0 Then
            Application.ScreenUpdating = False
            R = Application.RoundUp(rngSource.Rows.Count / Cols, 0)
            Set wksResult = Worksheets.Add: wksResult.Name = "Result_"
            For X = 0 To rngSource.Rows.Count Step R
                rngSource.Offset(X).Resize(R, rngSource.Columns.Count).Copy wksResult.Range("A2").Offset(, C)
                C = C + rngSource.Columns.Count
            Next
            Application.ScreenUpdating = True
        End If
    End If
End Sub