Split one column into multiple columns - excel

Question

I was wondering if anybody can kindly advise how to split a string with comma-separated values into multiple columns. I have been trying to figure this out but have been having a hard time finding a good solution. (also checked online, seems several that comes close but not necessarily fit what I exactly need)
Let's say I have a worksheet, call it "example", for instance,
and in the worksheet has the following strings under multiple
rows but all in column "A".
20120112,aaa,bbb,ccc,3432
20120113,aaa,bbb,ccc
20120113,ddd,bb,ccc,ddd,eee,fff,ggg,hhhh
20120132,aaa,bbb,ccc
20120112,aaa,bbb,ccc
20120112,xxx,bbb,ggg,ggg,333
20120112,aaa,bbb,ccc
20120112,abbd,bbb,ccc
How can I create a macro that will split the above into multiple columns.
Just several points
(1) I should be able to specify the worksheet name
ex: something like
worksheets("example").range(A,A) '
(2) The number of columns and rows are not fixed, and so I do not
know how many comma-separated values and how many rows there
would be before I run the vba script.

Answer 1

You could use InputBox() function and get the name of the sheet with data which shlould be splitted.
Then copy the data into variant array, split them and create new array of splitted values.
Finally assign the array of splitted values back to excel range. HTH
(Notice that the source data are modified directly so finally it is separated into columns and original un-splitted state is lost. But it is possible to modify the code so the original data won't be overwritten.)
Option Explicit
Private Const sourceColumnName As String = "A"
Private Const delimiter As String = ","
Public Sub Splitter()
' splits one column into multiple columns
Dim sourceSheetName As String
Dim sourceSheet As Worksheet
Dim lastRow As Long
Dim uboundMax As Integer
Dim result
On Error GoTo SplitterErr
sourceSheetName = VBA.InputBox("Enter name of the worksheet:")
If sourceSheetName = "" Then _
Exit Sub
Set sourceSheet = Worksheets(sourceSheetName)
With sourceSheet
lastRow = .Range(sourceColumnName & .rows.Count).End(xlUp).row
result = SplittedValues(data:=.Range(.Cells(1, sourceColumnName), _
.Cells(lastRow, sourceColumnName)), _
partsMaxLenght:=uboundMax)
If Not IsEmpty(result) Then
.Range(.Cells(1, sourceColumnName), _
.Cells(lastRow, uboundMax)).value = result
End If
End With
SplitterErr:
If Err.Number <> 0 Then _
MsgBox Err.Description, vbCritical
End Sub
Private Function SplittedValues( _
data As Range, _
ByRef partsMaxLenght As Integer) As Variant
Dim r As Integer
Dim parts As Variant
Dim values As Variant
Dim value As Variant
Dim splitted As Variant
If Not IsArray(data) Then
' data consists of one cell only
ReDim values(1 To 1, 1 To 1)
values(1, 1) = data.value
Else
values = data.value
End If
ReDim splitted(LBound(values) To UBound(values))
For r = LBound(values) To UBound(values)
value = values(r, 1)
If IsEmpty(value) Then
GoTo continue
End If
' Split always returns zero based array so parts is zero based array
parts = VBA.Split(value, delimiter)
splitted(r) = parts
If UBound(parts) + 1 > partsMaxLenght Then
partsMaxLenght = UBound(parts) + 1
End If
continue:
Next r
If partsMaxLenght = 0 Then
Exit Function
End If
Dim matrix As Variant
Dim c As Integer
ReDim matrix(LBound(splitted) To UBound(splitted), _
LBound(splitted) To partsMaxLenght)
For r = LBound(splitted) To UBound(splitted)
parts = splitted(r)
For c = 0 To UBound(parts)
matrix(r, c + 1) = parts(c)
Next c
Next r
SplittedValues = matrix
End Function

Answer 2

If you don't need to work on this task later again, here is a manual way as workaround:
Use a text editor (Notepad++) to replace "," to "tab".
Copy the content and paste into an empty Excel sheet.
Or you can try Excel import the data from file ("," as separator).
In case you need an automatic script, try this:
1) Press Ctrl+F11 to open VBA editor, insert a Module.
2) click the Module, add code inside as below.
Option Explicit
Public Function LastRowWithData(ByRef sht As Excel.Worksheet, Optional colName As String = "A") As Long
LastRowWithData = sht.Range(colName & sht.Rows.Count).End(xlUp).Row
End Function
Sub SplitToColumns(ByRef sColNames As String, ByRef strSeparator As String, ByRef rngDest As Excel.Range)
Dim arrColNames As Variant, i As Long
arrColNames = Split(sColNames, strSeparator)
For i = LBound(arrColNames) To UBound(arrColNames)
rngDest.Offset(0, i).Value = arrColNames(i)
Next i
End Sub
Sub PerformTheSplit()
Dim totalRows As Long, i As Long, sColNames As String
totalRows = LastRowWithData(Sheet1, "A")
For i = 1 To totalRows
sColNames = Sheet1.Range("A" & i).Value
Call SplitToColumns(sColNames, ",", Sheet2.Range("A" & i))
Next i
End Sub
3) Suppose you have the column name in Sheet1:
Press "Alt+F8" to run macro "PerformTheSplit", you will see result in Sheet2:

Answer 3

I would just use the Text-to-Columns wizard, with VBA routines to allow you to select the sheet and range to process, as you request above.
The Input boxes are used to obtain the sheet and range to process, and will default to the Active Sheet and Selection. This could certainly be modified in a variety of ways.
The built-in text to columns feature is then called, and, although you did not so specify, ti seems your first column represents a date in YMD format, so I added that as an option -- it should be obvious how to remove or change it if required.
Let me know how it works for you:
Option Explicit
Sub TTC_SelectWS_SelectR()
Dim WS As Worksheet, R As Range
Dim sMB As String
Dim v
On Error Resume Next
Set WS = Worksheets(Application.InputBox(Prompt:="Enter Worksheet Name: ", _
Title:="Select Worksheet", _
Default:=ActiveSheet.Name, _
Type:=2))
If Err.Number <> 0 Then
sMB = MsgBox("Invalid Worksheet Name", vbRetryCancel)
If sMB = vbRetry Then TTC_SelectWS_SelectR
Exit Sub
End If
On Error GoTo 0
Set R = (Application.InputBox(Prompt:="Select Range to Process: ", _
Title:="Select Range", _
Default:=Selection.Address, _
Type:=8))
Set R = WS.Range(R.Address)
R.TextToColumns DataType:=xlDelimited, textqualifier:=xlTextQualifierDoubleQuote, _
consecutivedelimiter:=False, Tab:=False, semicolon:=False, comma:=True, Space:=False, _
other:=False, fieldinfo:=Array(Array(1, xlYMDFormat))
End Sub