split characters in one cell to columns and create new columns

K

knotka

New Member
Joined
Sep 26, 2013
Messages
6
I have a table and I need to split characters within a table in easy way
[TABLE="width: 500"]
<tbody>[TR]
[TD]ID[/TD]
[TD]q1[/TD]
[TD]q2[/TD]
[TD]q3[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]0301|0303|0307[/TD]
[TD]07065|07567[/TD]
[TD]090861|090862|090863|090864|090865|090867|090869[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]0301|0303|0307|0308[/TD]
[TD]07565|07567|07569[/TD]
[TD]090861|090862|090863|090864[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]0301|0302[/TD]
[TD]07457|07458[/TD]
[TD]090861|090862[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]0301|0302|0304|0309[/TD]
[TD]07457|07458|07459[/TD]
[TD]090861|090862|090863|090864|090865|090867|090870[/TD]
[/TR]
</tbody>[/TABLE]

it should become like this
[TABLE="width: 500"]
<tbody>[TR]
[TD]ID[/TD]
[TD]q1[/TD]
[TD]q2[/TD]
[TD]q3[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]0301[/TD]
[TD]07065[/TD]
[TD]090861[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]0303[/TD]
[TD]07567[/TD]
[TD]090862[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]0307[/TD]
[TD][/TD]
[TD]090863[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD][/TD]
[TD][/TD]
[TD]090864[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD][/TD]
[TD][/TD]
[TD]090865[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD][/TD]
[TD][/TD]
[TD]090867[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD][/TD]
[TD][/TD]
[TD]090869[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]0301[/TD]
[TD]07565[/TD]
[TD]090861[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]0303[/TD]
[TD]07567[/TD]
[TD]090862[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]0307[/TD]
[TD]07569[/TD]
[TD]090863[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]0308[/TD]
[TD][/TD]
[TD]090864[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]0301[/TD]
[TD]07457[/TD]
[TD]090861[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]0302[/TD]
[TD]07458[/TD]
[TD]090862[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]0301[/TD]
[TD]07457[/TD]
[TD]090861[/TD]
[/TR]
</tbody>[/TABLE]

and so on

Please advice the easy way!
Many thanks
 

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.
Sort by date Sort by votes
Hi knotka,

Perhaps try something like this:

Code: 
Sub example()

    Dim vArr        As Variant
    Dim vOut        As Variant
    Dim v           As Variant
    Dim inpRow      As Long
    Dim inpCol      As Long
    Dim k           As Long
    Dim m           As Long
    Dim n           As Long

    ' get input data from Sheet1
    vArr = Sheet1.Range("A2:D5")
    ' initialise the output array
    ' (change 50000 to a bigger number
    ' if more output rows are expected)
    ReDim vOut(1 To 50000, 1 To 4)
    
    ' build the ouput array
    For inpRow = 1 To UBound(vArr, 1)
        ' store the starting output row - 1
        ' for the current input row
        n = n + m
        m = 0
        For inpCol = 2 To UBound(vArr, 2)
            k = 0
            For Each v In Split(vArr(inpRow, inpCol), "|")
                k = k + 1
                vOut(n + k, 1) = vArr(inpRow, 1)
                vOut(n + k, inpCol) = v
            Next v
            ' store the size of the
            ' cell with most delimiters
            ' for the current input row
            m = Application.Max(m, k)
        Next inpCol
    Next inpRow
    
    ' print output to Sheet2
    Sheet2.Range("A2").Resize(UBound(vOut, 1), _
                              UBound(vOut, 2)) = vOut

End Sub
 
Upvote 0
knotka,

Welcome to the MrExcel forum.

Do any entries for q1, q2, or q3, NOT have/contain the | symbol?
 
Upvote 0
Here is another macro for you to try... it is shorter than the one circledchicken posted and, surprising to me because we both processed everything in memory (using totally different methods), it also appears to be faster as well.

Rich (BB code): 
Sub SplitDataDown()
  Dim X As Long, Z As Long, I As Long, Index As Long, MaxUB As Long
  Dim Q1() As String, Q2() As String, Q3() As String
  Dim ArrIn As Variant, ArrOut As Variant
  Const MaxItemsPerCell As Long = 10
  ArrIn = Worksheets("Sheet1").Range("A2:D" & Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row)
  ReDim ArrOut(1 To MaxItemsPerCell * UBound(ArrIn), 1 To 4)
  For X = 1 To UBound(ArrIn)
    Q1 = Split(ArrIn(X, 2) & "|", "|")
    Q2 = Split(ArrIn(X, 3) & "|", "|")
    Q3 = Split(ArrIn(X, 4) & "|", "|")
    MaxUB = WorksheetFunction.Max(UBound(Q1), UBound(Q2), UBound(Q3))
    For Z = 0 To MaxUB
      Index = Index + 1
      ArrOut(Index, 1) = ArrIn(X, 1)
      If Z <= UBound(Q1) Then ArrOut(Index, 2) = CStr(Q1(Z))
      If Z <= UBound(Q2) Then ArrOut(Index, 3) = CStr(Q2(Z))
      If Z <= UBound(Q3) Then ArrOut(Index, 4) = CStr(Q3(Z))
    Next
  Next
  With Worksheets("Sheet2")
    .Range("A1:D1").Value = Worksheets("Sheet1").Range("A1:D1").Value
    .Range("A2:D" & UBound(ArrOut)).NumberFormat = "@"
    .Range("A2:D" & UBound(ArrOut)) = ArrOut
  End With
End Sub

Edit Note: I forgot to mention originally that you need to set the MaxItemsPerCell constant (highlighted in red) to a number guaranteed to be equal to or larger than the most delimited items you will ever have in a single cell (one|two|three would contain 3 delimited items)... but, for memory conservation reasons, try and keep the number as small as possible.
 
Last edited:
Upvote 0
Rick Rothstein said:
...surprising to me because we both processed everything in memory (using totally different methods), it also appears to be faster as well.
Click to expand...
I retract the above statement. My initial test was with 4 rows of data and a consistent 0.05 second speed difference showed up, but in testing both our routines against with 1000 rows of data show they both execute, consistently, in the same amount of time. That is more like what I would expect from two routines processing all loops totally in memory.
 
Upvote 0
Rick Rothstein said:
I retract the above statement. My initial test was with 4 rows of data and a consistent 0.05 second speed difference showed up, but in testing both our routines against with 1000 rows of data show they both execute, consistently, in the same amount of time. That is more like what I would expect from two routines processing all loops totally in memory.
Click to expand...

oh thank you very much! it helps me a lot as a start. This was just an example and there are more columns and rows and characters in the cell much longer but I'll try to figure out how to deal with that. But as a start for me is just great

xxx :)
 
Upvote 0
circledchicken said:
Hi knotka,

Perhaps try something like this:

Code: 
Sub example()

    Dim vArr        As Variant
    Dim vOut        As Variant
    Dim v           As Variant
    Dim inpRow      As Long
    Dim inpCol      As Long
    Dim k           As Long
    Dim m           As Long
    Dim n           As Long

    ' get input data from Sheet1
    vArr = Sheet1.Range("A2:D5")
    ' initialise the output array
    ' (change 50000 to a bigger number
    ' if more output rows are expected)
    ReDim vOut(1 To 50000, 1 To 4)
    
    ' build the ouput array
    For inpRow = 1 To UBound(vArr, 1)
        ' store the starting output row - 1
        ' for the current input row
        n = n + m
        m = 0
        For inpCol = 2 To UBound(vArr, 2)
            k = 0
            For Each v In Split(vArr(inpRow, inpCol), "|")
                k = k + 1
                vOut(n + k, 1) = vArr(inpRow, 1)
                vOut(n + k, inpCol) = v
            Next v
            ' store the size of the
            ' cell with most delimiters
            ' for the current input row
            m = Application.Max(m, k)
        Next inpCol
    Next inpRow
    
    ' print output to Sheet2
    Sheet2.Range("A2").Resize(UBound(vOut, 1), _
                              UBound(vOut, 2)) = vOut

End Sub
Click to expand...

Thank you too :) I didn't go through much in your code as I used easy and short one from Rick, but I'm sure when I'll be going through his code and add some more I'll come back to yours too!
But thank you a lot for answer!
 
Upvote 0
You're welcome - thanks for the feedback.

If you need to handle a lot more columns, my setup may scale more easily than Rick's.
Regarding the size of the code, I think that is largely due to spacing and comments.

Rick's version correctly adjusted for leading zero's though, and mine did not.
Below is an amendment to my version for a similar result:

Code: 
Sub example()

    Dim vArr        As Variant
    Dim vOut        As Variant
    Dim v           As Variant
    Dim inpRow      As Long
    Dim inpCol      As Long
    Dim k           As Long
    Dim m           As Long
    Dim n           As Long

    ' get input data from Sheet1
    vArr = Sheet1.Range("A2:Z100").Value2
    ' initialise the output array
    ' (change 50000 to a bigger number
    ' if more output rows are expected)
    ReDim vOut(1 To 50000, 1 To UBound(vArr, 2))
    
    ' build the ouput array
    For inpRow = 1 To UBound(vArr, 1)
        ' store the starting output row - 1
        ' for the current input row
        n = n + m
        m = 0
        For inpCol = 2 To UBound(vArr, 2)
            k = 0
            For Each v In Split(vArr(inpRow, inpCol), "|")
                k = k + 1
                vOut(n + k, 1) = vArr(inpRow, 1)
                vOut(n + k, inpCol) = v
            Next v
            ' store the size of the
            ' cell with most delimiters
            ' for the current input row
            m = Application.Max(m, k)
        Next inpCol
    Next inpRow
    
    ' print output to Sheet2
    With Sheet2.Range("A2").Resize(UBound(vOut, 1), _
                                   UBound(vOut, 2))
        .NumberFormat = "@"
        .Value2 = vOut
    End With

End Sub
Adjusting the range as appropriate for your actual data set should allow this to scale easily for more rows and columns.
(You can also increase the output array size if required - i.e if you expect the output to result in more than 50000 rows, just change it to 100000 for example or something larger).
 
Last edited:
Upvote 0
You must log in or register to reply here.

Forum statistics

Threads
1,223,230
Messages
6,170,883
Members
452,364
Latest member
springate

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top