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

Bond007 · Dec 1, 2008

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!

sainathd · Aug 30, 2017

VoG said:

This splits column M. I've tested this with over 200 rows of data with no error (Excel 2007).

Code:

Sub Splt()
Dim LR As Long, i As Long
Dim X As Variant
Application.ScreenUpdating = False
LR = Range("M" & Rows.Count).End(xlUp).Row
Columns("M").Insert
For i = LR To 1 Step -1
    With Range("N" & 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("N").Delete
LR = Range("M" & Rows.Count).End(xlUp).Row
With Range("A1:Q" & LR)
    On Error Resume Next
    .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
    On Error GoTo 0
    .Value = .Value
End With
Application.ScreenUpdating = True
End Sub

Worked like a charm

Yakkie · Nov 30, 2017

Hi Guys,

Sorr to bring up a old thread.

I am new to this forum. And need some help from you all.

I need to split some data in a cell to different rows and try some of the codes given but unsuccessful.

example as below:

Raw Data

Rooms	Date	Start	End	Day	Weeks	Event
RM901/RM902; RM903/RM904	11/04/2017	12:30 PM	2:30 PM	Tuesday	16	FOOTBALL

Desired Outcome

Rooms	Date	Start	End	Day	Weeks	Event
RM901	11/04/2017	12:30 PM	2:30 PM	Tuesday	16	FOOTBALL
RM902	11/04/2017	12:30 PM	2:30 PM	Tuesday	16	FOOTBALL
RM903	11/04/2017	12:30 PM	2:30 PM	Tuesday	16	FOOTBALL
RM904	11/04/2017	12:30 PM	2:30 PM	Tuesday	16	FOOTBALL

Please advise.. and thanks in advance.. my current raw data can go up to 100000 rows

Cheers

István Hirsch · Nov 30, 2017

Give this a try if about 100 sec to process 100.000 cells is OK. If not, somebody better with arrays will certainly help.

Code:

Sub Sep()
Dim c As Range
    For Each c In Range("A2", Range("A" & Rows.Count).End(xlUp))
        c = Replace(c, ";", "/")
        x = Split(c, "/")
            For i = 0 To UBound(x)
                Cells(2 + y + i, 9) = x(i)
                Cells(2 + y + i, 10) = Cells(2 + k, 2)
                Cells(2 + y + i, 11) = Cells(2 + k, 3)
                Cells(2 + y + i, 12) = Cells(2 + k, 4)
                Cells(2 + y + i, 13) = Cells(2 + k, 5)
                Cells(2 + y + i, 14) = Cells(2 + k, 6)
                Cells(2 + y + i, 15) = Cells(2 + k, 7)
            Next
            y = y + i: k = k + 1
    Next
End Sub

Rick Rothstein · Nov 30, 2017

István Hirsch said:

Give this a try if about 100 sec to process 100.000 cells is OK. If not, somebody better with arrays will certainly help.

Code:

Sub Sep()
Dim c As Range
    For Each c In Range("A2", Range("A" & Rows.Count).End(xlUp))
        c = Replace(c, ";", "/")
        x = Split(c, "/")
            For i = 0 To UBound(x)
                Cells(2 + y + i, 9) = [B][COLOR="#FF0000"]Trim([/COLOR][/B]x(i)[B][COLOR="#FF0000"])[/COLOR][/B]
                Cells(2 + y + i, 10) = Cells(2 + k, 2)
                Cells(2 + y + i, 11) = Cells(2 + k, 3)
                Cells(2 + y + i, 12) = Cells(2 + k, 4)
                Cells(2 + y + i, 13) = Cells(2 + k, 5)
                Cells(2 + y + i, 14) = Cells(2 + k, 6)
                Cells(2 + y + i, 15) = Cells(2 + k, 7)
            Next
            y = y + i: k = k + 1
    Next
End Sub

Your code is preserving a leading blank space in front of some of the room name... it comes from the blank space after the semi-colons. The suggested change shown above in red will fix the problem.

Your code takes about 120 seconds on my computer to process 100,000 rows of data. In an effort to try to speed things up, I develope the following code which does all of the processing in memory before blasting the results to the worksheet all at once... the code took about 5 seconds to do that.

Code:

[table="width: 500"]
[tr]
	[td]Sub SeparateRooms()
  Dim R As Long, c As Long, x As Long, z As Long, LastRow As Long, TotalRooms As Long
  Dim Rooms As Variant, StaticData As Variant, Result As Variant, Rms() As String
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  Rooms = Range("A2:A" & LastRow)
  StaticData = Range("B2:G" & LastRow)
  TotalRooms = Evaluate(Replace("SUM(IF(A2:A#="""","""",1+LEN(A2:A#)-LEN(SUBSTITUTE(SUBSTITUTE(A2:A#,"";"",""/""),""/"",""""))))", "#", LastRow))
  ReDim Result(1 To TotalRooms, 1 To 7)
  For R = 1 To UBound(Rooms)
    Rms = Split(Replace(Rooms(R, 1), ";", "/"), "/")
    For x = 0 To UBound(Rms)
      z = z + 1
      Result(z, 1) = Trim(Rms(x))
      For c = 1 To UBound(StaticData, 2)
        Result(z, c + 1) = StaticData(R, c)
      Next
    Next
  Next
  Range("J2").Resize(UBound(Result, 1), UBound(Result, 2)) = Result
  Range("L2:M" & TotalRooms).NumberFormat = "h:mm AM/PM"
End Sub[/td]
[/tr]
[/table]

Yakkie · Nov 30, 2017

Rick Rothstein said:
Your code is preserving a leading blank space in front of some of the room name... it comes from the blank space after the semi-colons. The suggested change shown above in red will fix the problem.

Your code takes about 120 seconds on my computer to process 100,000 rows of data. In an effort to try to speed things up, I develope the following code which does all of the processing in memory before blasting the results to the worksheet all at once... the code took about 5 seconds to do that.

Code:

[TABLE="width: 500"] <tbody>[TR] [TD]Sub SeparateRooms() Dim R As Long, c As Long, x As Long, z As Long, LastRow As Long, TotalRooms As Long Dim Rooms As Variant, StaticData As Variant, Result As Variant, Rms() As String LastRow = Cells(Rows.Count, "A").End(xlUp).Row Rooms = Range("A2:A" & LastRow) StaticData = Range("B2:G" & LastRow) TotalRooms = Evaluate(Replace("SUM(IF(A2:A#="""","""",1+LEN(A2:A#)-LEN(SUBSTITUTE(SUBSTITUTE(A2:A#,"";"",""/""),""/"",""""))))", "#", LastRow)) ReDim Result(1 To TotalRooms, 1 To 7) For R = 1 To UBound(Rooms) Rms = Split(Replace(Rooms(R, 1), ";", "/"), "/") For x = 0 To UBound(Rms) z = z + 1 Result(z, 1) = Trim(Rms(x)) For c = 1 To UBound(StaticData, 2) Result(z, c + 1) = StaticData(R, c) Next Next Next Range("J2").Resize(UBound(Result, 1), UBound(Result, 2)) = Result Range("L2:M" & TotalRooms).NumberFormat = "h:mm AM/PM" End Sub[/TD] [/TR] </tbody>[/TABLE]

Thanks guys.. it works.. 100 sec or better 5 sec definitely beats me splitting the data manually by days... sure save me loads of time... greatly appreciated..

Hi Rick, if i use your code... and i have additional columns to be added in (some other booking details and remarks), maybe to column J.. do i just change StaticData = Range("B2:J" & LastRow)?

Thanks again guys

Rick Rothstein · Nov 30, 2017

Yakkie said:
Hi Rick, if i use your code... and i have additional columns to be added in (some other booking details and remarks), maybe to column J.. do i just change StaticData = Range("B2:J" & LastRow)?

Yes, that should be all you need to do.

Yakkie · Nov 30, 2017

Rick Rothstein said:
Yes, that should be all you need to do.

Hi Rick, seems that i run into
run-time error '9'
Subsciprt out of range

anything else i missed out?

Rick Rothstein · Nov 30, 2017

Yakkie said:
Hi Rick, seems that i run into
run-time error '9'
Subsciprt out of range

anything else i missed out?

Nope, you didn't miss anything... I did.

I accidentally had left a hard-coded number in my code that should have been converted to an expression which calculates the number of columns to resize the Result array to. Here is the corrected code... you still only need to change the line of code you identified for yourself.

Code:

[table="width: 500"]
[tr]
	[td]Sub SeparateRooms()
  Dim R As Long, c As Long, x As Long, z As Long, LastRow As Long, TotalRooms As Long
  Dim Rooms As Variant, StaticData As Variant, Result As Variant, Rms() As String
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  Rooms = Range("A2:A" & LastRow)
  StaticData = Range("B2:G" & LastRow)
  TotalRooms = Evaluate(Replace("SUM(IF(A2:A#="""","""",1+LEN(A2:A#)-LEN(SUBSTITUTE(SUBSTITUTE(A2:A#,"";"",""/""),""/"",""""))))", "#", LastRow))
  ReDim Result(1 To TotalRooms, 1 To UBound(StaticData, 2) + 1)
  For R = 1 To UBound(Rooms)
    Rms = Split(Replace(Rooms(R, 1), ";", "/"), "/")
    For x = 0 To UBound(Rms)
      z = z + 1
      Result(z, 1) = Trim(Rms(x))
      For c = 1 To UBound(StaticData, 2)
        Result(z, c + 1) = StaticData(R, c)
      Next
    Next
  Next
  Range("J2").Resize(UBound(Result, 1), UBound(Result, 2)) = Result
  Range("L2:M" & TotalRooms).NumberFormat = "h:mm AM/PM"
End Sub[/td]
[/tr]
[/table]

Yakkie · Dec 1, 2017

Rick Rothstein said:

Nope, you didn't miss anything... I did.

I accidentally had left a hard-coded number in my code that should have been converted to an expression which calculates the number of columns to resize the Result array to. Here is the corrected code... you still only need to change the line of code you identified for yourself.

Code:

[TABLE="width: 500"]
<tbody>[TR]
[TD]Sub SeparateRooms()
  Dim R As Long, c As Long, x As Long, z As Long, LastRow As Long, TotalRooms As Long
  Dim Rooms As Variant, StaticData As Variant, Result As Variant, Rms() As String
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  Rooms = Range("A2:A" & LastRow)
  StaticData = Range("B2:G" & LastRow)
  TotalRooms = Evaluate(Replace("SUM(IF(A2:A#="""","""",1+LEN(A2:A#)-LEN(SUBSTITUTE(SUBSTITUTE(A2:A#,"";"",""/""),""/"",""""))))", "#", LastRow))
  ReDim Result(1 To TotalRooms, 1 To UBound(StaticData, 2) + 1)
  For R = 1 To UBound(Rooms)
    Rms = Split(Replace(Rooms(R, 1), ";", "/"), "/")
    For x = 0 To UBound(Rms)
      z = z + 1
      Result(z, 1) = Trim(Rms(x))
      For c = 1 To UBound(StaticData, 2)
        Result(z, c + 1) = StaticData(R, c)
      Next
    Next
  Next
  Range("J2").Resize(UBound(Result, 1), UBound(Result, 2)) = Result
  Range("L2:M" & TotalRooms).NumberFormat = "h:mm AM/PM"
End Sub[/TD]
[/TR]
</tbody>[/TABLE]

It works!!! Thanks alot Rick!!!

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

Bond007

New Member

sainathd

New Member

Excel Facts

Yakkie

New Member

István Hirsch

Well-known Member

Rick Rothstein

MrExcel MVP

Yakkie

New Member

Rick Rothstein

MrExcel MVP

Yakkie

New Member

Rick Rothstein

MrExcel MVP

Yakkie

New Member

Similar threads

Forum statistics

Share this page

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

New Member

New Member

Excel Facts

New Member

Well-known Member

MrExcel MVP

New Member

MrExcel MVP

New Member

MrExcel MVP

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock