Split Rows data into new worksheet rows with specify words length

[monkeyz]

Hello, Good Day,
I need to split many rows data and save into new worksheet rows,
First, split the data with delimiter"|||", and I can select length in each split data, (in the example I choose text length is 16)

Original Data need to be split .

Label	Original Data
Label A	Peter 11AA, 22BB, 33CC,|||Ann ABC, 115C,|||Nick P122, C502, 607,
Label B	Monkey 1356, 28BC, ABC, 68ED, P2,|||Jordon N134, 1C,|||Nelson 6B, 90D2, 2001A, 22BB,|||May P112, C702, E607,

<tbody>
</tbody>

....
....
....


After split, I want the data, as below:

Label	Split Data
Label A	Peter 11AA,
Label A	Peter 22BB,
Label A	Peter 33CC,
Label A	Ann ABC, 115C,
Label A	Nick P122, C502,
Label A	Nick 607,
Label B	Monkey 1356,
Label B	Monkey 28BC,
Label B	Monkey ABC,
Label B	Monkey 68ED, P2,
Label B	Jordon N134, 1C,
Label B	Nelson 6B, 90D2,
Label B	Nelson 2001A,
Label B	Nelson 22BB,
Label B	May P112, C702,
Label B	May E607,

<tbody>
</tbody>

Thank you for your time

 

[MickG]

Try this for results starting "D1".
NB:- There appears to be some inconsistencies in your data in second column of results like:-

Nick P122, C502,

Nick 607, The above should, perhaps should be 3 lines "Nick P122" then "Nick C502", then "Nick 607" [COLOR=navy]Sub[/COLOR] MG17Mar49 [COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] Range, Sp [COLOR=navy]As[/COLOR] Variant, SPa [COLOR=navy]As[/COLOR] Variant [COLOR=navy]Dim[/COLOR] n [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] nn [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] c [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Ray(), Nam [COLOR=navy]As[/COLOR] [COLOR=navy]String[/COLOR] [COLOR=navy]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp)) [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng Sp = Split(Dn.Offset(, 1), "|||") [COLOR=navy]For[/COLOR] n = 0 To UBound(Sp) SPa = Split(Sp(n), ", ") [COLOR=navy]For[/COLOR] nn = 0 To UBound(SPa) [COLOR=navy]If[/COLOR] nn = 0 [COLOR=navy]Then[/COLOR] Nam = Split(SPa(0), " ")(0) SPa(0) = Split(SPa(0), " ")(1) [COLOR=navy]End[/COLOR] If c = c + 1 ReDim Preserve Ray(1 To 2, 1 To c) Ray(1, c) = Dn.Value: Ray(2, c) = Nam & ", " & SPa(nn) [COLOR=navy]Next[/COLOR] nn [COLOR=navy]Next[/COLOR] n [COLOR=navy]Next[/COLOR] Dn Range("D1").Resize(c, 2).Value = Application.Transpose(Ray) [COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR] Regards Mick

<tbody>
</tbody>

 

[monkeyz]

Hello, Mick,
Thanks,
because I also want to control the words length, and in the case, I allow the max text length is 16,
so After split, some column contains multiple element.
such as below output array length is 14, 16,

Label A	Ann ABC, 115C,
Label A	Nick P122, C502, How can I add the function? Many Thanks,

<tbody>
</tbody>

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG18Mar27
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, sp [COLOR="Navy"]As[/COLOR] Variant, SPa [COLOR="Navy"]As[/COLOR] Variant, Txt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] nn [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ray(), Nam [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] Xt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range("A2", Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    sp = Split(Dn.Offset(, 1), "|||")
        [COLOR="Navy"]For[/COLOR] n = 0 To UBound(sp)
            SPa = Split(sp(n), ", ")
            [COLOR="Navy"]For[/COLOR] nn = 0 To UBound(SPa)
                    [COLOR="Navy"]If[/COLOR] nn = 0 [COLOR="Navy"]Then[/COLOR]
                        Nam = Split(SPa(0), " ")(0)
                        Txt = Nam
                    [COLOR="Navy"]End[/COLOR] If
             
                    Xt = IIf(nn = 0, Split(SPa(0), " ")(1), SPa(nn))
                  
                    [COLOR="Navy"]If[/COLOR] Len(Nam & "," & Xt) < 16 [COLOR="Navy"]Then[/COLOR]
                            Nam = Nam & ", " & Xt
                    [COLOR="Navy"]ElseIf[/COLOR] nn < UBound(SPa) + 1 [COLOR="Navy"]Then[/COLOR]
                            c = c + 1
                            ReDim Preserve Ray(1 To 2, 1 To c)
                            Ray(1, c) = Dn.Value: Ray(2, c) = Nam
                            Nam = Txt & ", " & SPa(nn)
                   [COLOR="Navy"]End[/COLOR] If
           [COLOR="Navy"]Next[/COLOR] nn
                   [COLOR="Navy"]If[/COLOR] nn = UBound(SPa) + 1 [COLOR="Navy"]Then[/COLOR]
                        c = c + 1
                        ReDim Preserve Ray(1 To 2, 1 To c)
                        Ray(1, c) = Dn.Value: Ray(2, c) = Nam
                   [COLOR="Navy"]End[/COLOR] If
     [COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]Next[/COLOR] Dn
Range("D1").Resize(c, 2).Value = Application.Transpose(Ray)
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick