How to split single text cell into multiple rows, using a comma delimiter?

[Bond007]

Hello - could anyone help me? I have a string of text in one cell on Sheet 1 (ie., A1, Sheet 1), here is a excerpt:

A-dec International Inc., A. Bellotti, A. DEPPELER S.A., etc ...

What I need to do is split the cell into separate rows, using the comma as a delimiter. I will be reading the cell from another sheet and need a formula that will provide me with

A1: A-dec International Inc.
A2: A. Bellotti
A3: A. DEPPELER S.A.

Many Thanks!

 

[VoG]

The code you originally provided me didn't work as it stood, and I'm simply not clever enough to modify it so that it will work with my added columns.

Is there a shortcut way to have column A split without specifying a limit to the number of columns which include data? So rather than terminating at C, D, or E it will work regardless?

Would I be better served to give the code provided to cduerson modifying the references to columns M and N to A and B respectively?

Try this

Sub Splt()
Dim LR As Long, i As Long, LC As Integer
Dim X As Variant
Application.ScreenUpdating = False
LR = Range("A" & Rows.Count).End(xlUp).Row
LC = Cells(1, Columns.Count).End(xlToLeft).Column
Columns("A").Insert
For i = LR To 1 Step -1
    With Range("B" & i)
        If InStr(.Value, ",") = 0 Then
            .Offset(, -1).Value = .Value
        Else
            X = Split(.Value, ",")
            .Offset(1).Resize(UBound(X)).EntireRow.Insert
            .Offset(, -1).Resize(UBound(X) - LBound(X) + 1).Value = Application.Transpose(X)
        End If
    End With
Next i
Columns("B").Delete
LR = Range("A" & Rows.Count).End(xlUp).Row
With Range(Cells(1, 2), Cells(LR, LC))
    On Error Resume Next
    .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
    On Error GoTo 0
    .Value = .Value
End With
Application.ScreenUpdating = True
End Sub

 

[CharterJace]

Try this

By gosh, by golly I think it worked! At least I didn't encounter any immediate "gotchas!" Granted, this spreadsheet had over 3200 rows of data BEFORE I ran the code, so it will take some time for me to get through it.

But at first glance, it looks like you saved my life.

 

[cduerson]

The code works great and does what I need , however it is still blowing up after 40 rows.

I'm using Excel 2003 SP3, any thoughts?

 

[VoG]

The code works great and does what I need , however it is still blowing up after 40 rows.

I'm using Excel 2003 SP3, any thoughts?

Try adding this right at the top of the module [before Sub Splt()]

Option Explicit

 

[cduerson]

Peter,
No luck, it still dies after 40 lines.

 

[VoG]

Sorry but as I can't reproduce the problem I can't suggest anything further.

 

[cduerson]

Thank you sir, I will fool around with it and do some more research.

There are several reports I get like this and the comma data in column "M" could be in other columns. Can I just replace "M" with the new source column and then alter the Delete function at the end to reflect the new "M" + 1?

 

[VoG]

Try this: it will prompt you to click in the column to be split.

Option Explicit

Sub Splt()
Dim LR As Long, i As Long, LC As Integer
Dim X As Variant
Dim r As Range, iCol As Integer
On Error Resume Next
Set r = Application.InputBox("Click in the column to split by", Type:=8)
On Error GoTo 0
If r Is Nothing Then Exit Sub
iCol = r.Column
Application.ScreenUpdating = False
LC = Cells(1, Columns.Count).End(xlToLeft).Column
LR = Cells(Rows.Count, iCol).End(xlUp).Row
Columns(iCol).Insert
For i = LR To 1 Step -1
    With Cells(i, iCol + 1)
        If InStr(.Value, ",") = 0 Then
            .Offset(, -1).Value = .Value
        Else
            X = Split(.Value, ",")
            .Offset(1).Resize(UBound(X)).EntireRow.Insert
            .Offset(, -1).Resize(UBound(X) - LBound(X) + 1).Value = Application.Transpose(X)
        End If
    End With
Next i
Columns(iCol + 1).Delete
LR = Cells(Rows.Count, iCol).End(xlUp).Row
With Range(Cells(1, 1), Cells(LR, LC))
    On Error Resume Next
    .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
    On Error GoTo 0
    .Value = .Value
End With
Application.ScreenUpdating = True
End Sub

 

[cduerson]

You rock, thank you sir.

It works great (except the 40 line thing ). I have some cells in my dataa that are blank and it looks like a variable is not getting cleared out because the previous data is being copied to the previously blank cells.

I will let you know what I come up with on the error.

Thanks for all your help.

 

[CharterJace]

You rock, thank you sir.

It works great (except the 40 line thing ). I have some cells in my dataa that are blank and it looks like a variable is not getting cleared out because the previous data is being copied to the previously blank cells.

I will let you know what I come up with on the error.

Thanks for all your help.

Have you tried repairing your installation of Office? Just curious if that may help with your 40 line debacle.