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
 

circledchicken

Well-known Member
Joined
Aug 13, 2011
Messages
2,932
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
 

hiker95

Well-known Member
Joined
Apr 8, 2009
Messages
17,648
knotka,

Welcome to the MrExcel forum.

Do any entries for q1, q2, or q3, NOT have/contain the | symbol?
 

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
35,568
Office Version
2010
Platform
Windows
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:

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
35,568
Office Version
2010
Platform
Windows
...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.
 

knotka

New Member
Joined
Sep 26, 2013
Messages
6
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 :)
 

knotka

New Member
Joined
Sep 26, 2013
Messages
6
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!
 

knotka

New Member
Joined
Sep 26, 2013
Messages
6
knotka,

Welcome to the MrExcel forum.

Do any entries for q1, q2, or q3, NOT have/contain the | symbol?
all contain that symbol just if there is one number in the cell it's not contain this charachter
 

circledchicken

Well-known Member
Joined
Aug 13, 2011
Messages
2,932
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:

Forum statistics

Threads
1,085,335
Messages
5,383,032
Members
401,812
Latest member
topherj09

Some videos you may like

This Week's Hot Topics

Top