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 .

[TABLE="width: 800"]
<tbody>[TR]
[TD]Label[/TD]
[TD]Original Data[/TD]
[/TR]
[TR]
[TD]Label A[/TD]
[TD]Peter 11AA, 22BB, 33CC,|||Ann ABC, 115C,|||Nick P122, C502, 607,[/TD]
[/TR]
[TR]
[TD]Label B[/TD]
[TD]Monkey 1356, 28BC, ABC, 68ED, P2,|||Jordon N134, 1C,|||Nelson 6B, 90D2, 2001A, 22BB,|||May P112, C702, E607,[/TD]
[/TR]
</tbody>[/TABLE]
....
....
....


After split, I want the data, as below:


[TABLE="width: 500"]
<tbody>[TR]
[TD]Label[/TD]
[TD]Split Data[/TD]
[/TR]
[TR]
[TD]Label A[/TD]
[TD]Peter 11AA,[/TD]
[/TR]
[TR]
[TD]Label A[/TD]
[TD]Peter 22BB,[/TD]
[/TR]
[TR]
[TD]Label A[/TD]
[TD]Peter 33CC,[/TD]
[/TR]
[TR]
[TD]Label A[/TD]
[TD]Ann ABC, 115C,[/TD]
[/TR]
[TR]
[TD]Label A[/TD]
[TD]Nick P122, C502,[/TD]
[/TR]
[TR]
[TD]Label A[/TD]
[TD]Nick 607,[/TD]
[/TR]
[TR]
[TD]Label B[/TD]
[TD]Monkey 1356, [/TD]
[/TR]
[TR]
[TD]Label B[/TD]
[TD]Monkey 28BC,[/TD]
[/TR]
[TR]
[TD]Label B[/TD]
[TD]Monkey ABC,[/TD]
[/TR]
[TR]
[TD]Label B[/TD]
[TD]Monkey 68ED, P2,[/TD]
[/TR]
[TR]
[TD]Label B[/TD]
[TD]Jordon N134, 1C,[/TD]
[/TR]
[TR]
[TD]Label B[/TD]
[TD]Nelson 6B, 90D2,[/TD]
[/TR]
[TR]
[TD]Label B[/TD]
[TD]Nelson 2001A,[/TD]
[/TR]
[TR]
[TD]Label B[/TD]
[TD]Nelson 22BB,[/TD]
[/TR]
[TR]
[TD]Label B[/TD]
[TD]May P112, C702,[/TD]
[/TR]
[TR]
[TD]Label B[/TD]
[TD]May E607,[/TD]
[/TR]
</tbody>[/TABLE]



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:-[TABLE="class: cms_table"]
<tbody>[TR]
[TD]Nick P122, C502,
[/TD]
[/TR]
[TR]
[TD]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

[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

 

[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,
[TABLE="class: cms_table, width: 500"]
<tbody>[TR]
[TD]Label A[/TD]
[TD]Ann ABC, 115C,[/TD]
[/TR]
[TR]
[TD]Label A[/TD]
[TD]Nick P122, C502,


How can I add the function?


Many Thanks,[/TD]
[/TR]
</tbody>[/TABLE]

 

[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