split characters in one cell to columns and create new columns

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
IDq1q2q3
10301|0303|030707065|07567090861|090862|090863|090864|090865|090867|090869
20301|0303|0307|030807565|07567|07569090861|090862|090863|090864
30301|030207457|07458090861|090862
40301|0302|0304|030907457|07458|07459090861|090862|090863|090864|090865|090867|090870

<tbody>
</tbody>

it should become like this
IDq1q2q3
1030107065090861
1030307567090862
10307090863
1090864
1090865
1090867
1090869
2030107565090861
2030307567090862
2030707569090863
20308090864
3030107457090861
3030207458090862
4030107457090861

<tbody>
</tbody>

and so on

Please advice the easy way!
Many thanks
 

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.
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
...surprising to me because we both processed everything in memory (using totally different methods), it also appears to be faster as well.
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
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.

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
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

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

Forum statistics

Threads
1,213,543
Messages
6,114,238
Members
448,555
Latest member
RobertJones1986

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