VBA: Split text in cells to multiple rows

[sr1111]

Hi,

I am looking for a VBA to split the text into cells into rows.

Input:

test.xlsx
	A
1
2	Company, id*; ¤¤¤Communications Media, http://www.Communications.com/Media.
3	Company, id*1; ¤¤¤enter fr gic an, ght cer tit, reo th and ce ersit, and, p0 99, 9A. c e:9k@o.u.+=+enter fr gic an, ght cer tit, reo th and ce ersit, and, p0 99, 9A. c e:9k@o.u.+=+enter fr gic an, ght cer tit, reo th and ce ersit, and, p0 99, 9A. c e:9k@o.u..///Company, Name 33T; ¤¤¤enter fr gic an, ght cer tit, reo th and ce ersit, and, p0 99, 9A. c e:9k@o.u.///Company, Name 33T; ¤¤¤enter fr gic an, ght cer tit, reo th and ce ersit, and, p0 99, 9A. c e:9k@o.u.
Sheet1

Output1:

test.xlsx
	A
1
2	Company, id*; ¤¤¤Communications Media, http://www.Communications.com/Media.
3	Company, id*1; ¤¤¤enter fr gic an, ght cer tit, reo th and ce ersit, and, p0 99, 9A. c e:9k@o.u.+=+enter fr gic an, ght cer tit, reo th and ce ersit, and, p0 99, 9A. c e:9k@o.u.+=+enter fr gic an, ght cer tit, reo th and ce ersit, and, p0 99, 9A. c e:9k@o.u..
4	Company, Name 33T; ¤¤¤enter fr gic an, ght cer tit, reo th and ce ersit, and, p0 99, 9A. c e:9k@o.u.
5	Company, Name 33T; ¤¤¤enter fr gic an, ght cer tit, reo th and ce ersit, and, p0 99, 9A. c e:9k@o.u.
Sheet2

output2:

test.xlsx
	A
1
2	Company, id*; ¤¤¤Communications Media, http://www.Communications.com/Media.
3	Company, id*1; ¤¤¤enter fr gic an, ght cer tit, reo th and ce ersit, and, p0 99, 9A. c e:9k@o.u.
4	Company, id*1; enter fr gic an, ght cer tit, reo th and ce ersit, and, p0 99, 9A. c e:9k@o.u.
5	Company, id*1; enter fr gic an, ght cer tit, reo th and ce ersit, and, p0 99, 9A. c e:9k@o.u..
6	Company, Name 33T; ¤¤¤enter fr gic an, ght cer tit, reo th and ce ersit, and, p0 99, 9A. c e:9k@o.u.
7	Company, Name 33T; ¤¤¤enter fr gic an, ght cer tit, reo th and ce ersit, and, p0 99, 9A. c e:9k@o.u.
Sheet3

output3:

test.xlsx
	A	B
1
2	Company, id*	¤¤¤Communications Media, http://www.Communications.com/Media.
3	Company, id*1	¤¤¤enter fr gic an, ght cer tit, reo th and ce ersit, and, p0 99, 9A. c e:9k@o.u.
4	Company, id*1	enter fr gic an, ght cer tit, reo th and ce ersit, and, p0 99, 9A. c e:9k@o.u.
5	Company, id*1	enter fr gic an, ght cer tit, reo th and ce ersit, and, p0 99, 9A. c e:9k@o.u..
6	Company, Name 33T	¤¤¤enter fr gic an, ght cer tit, reo th and ce ersit, and, p0 99, 9A. c e:9k@o.u.
7	Company, Name 33T	¤¤¤enter fr gic an, ght cer tit, reo th and ce ersit, and, p0 99, 9A. c e:9k@o.u.
Sheet4

 

[rlv01]

Splitting text is all about patterns and/or rules. What are your rules for how the text should be split to a new line?

 

[alansidman]

Since you are using 2013, you can apply the splitting rules in Power Query (Available for download from MS) which allows to split the the results to rows and not just columns. Post #2 will help to understand your criteria.

 

[HongRu]

To make sure you rules to split text:
Rule 1. "///"
Rule 2. "+=+" and append "Company ID" which before "; "

How about the above rules?

 

[HongRu]

try this.

Sub sbSplitCompany()
    Dim R1 As Range
    Set R1 = Range("A2") 'set the first cell to split
    
    Dim R2 As Range
    Set R2 = Range("C2") 'set the first cell to put result
    R2.Offset(-1, 0) = "CompanyID" 'set the result title
    R2.Offset(-1, 1) = "Result"
    
    Dim i 'the i cell to split
    Dim myArray1 '1st split array
    Dim myArray2 '2nd split array
    Dim e  '1st array element
    Dim e2 '2nd array element
    Dim j 'check if the 1st element of 2nd split
    Dim myCompanyID 'Company ID
    
    Do Until R1.Offset(i, 0) = ""
        myArray1 = Split(R1.Offset(i, 0), "///") '1st split
        For Each e In myArray1
            myCompanyID = Split(e, "; ")(0) 'company ID
            myArray2 = Split(e, "+=+") '2nd split
            For Each e2 In myArray2
                R2.Offset(Rows.Count - R2.Row, 0).End(xlUp).Offset(1, 0) = myCompanyID 'CompanyId to R2
                If j = 0 Then 'judge if 1st e2
                    R2.Offset(Rows.Count - R2.Row, 1).End(xlUp).Offset(1, 0) = Split(e2, "; ")(1) '1st Result of e2 to R2
                Else
                    R2.Offset(Rows.Count - R2.Row, 1).End(xlUp).Offset(1, 0) = e2 'Result to R2
                End If
                j = j + 1
            Next e2
            j = 0
        Next e
        'next cell
        i = i + 1
    Loop
End Sub

 

[sr1111]

try this.

Sub sbSplitCompany()
    Dim R1 As Range
    Set R1 = Range("A2") 'set the first cell to split
  
    Dim R2 As Range
    Set R2 = Range("C2") 'set the first cell to put result
    R2.Offset(-1, 0) = "CompanyID" 'set the result title
    R2.Offset(-1, 1) = "Result"
  
    Dim i 'the i cell to split
    Dim myArray1 '1st split array
    Dim myArray2 '2nd split array
    Dim e  '1st array element
    Dim e2 '2nd array element
    Dim j 'check if the 1st element of 2nd split
    Dim myCompanyID 'Company ID
  
    Do Until R1.Offset(i, 0) = ""
        myArray1 = Split(R1.Offset(i, 0), "///") '1st split
        For Each e In myArray1
            myCompanyID = Split(e, "; ")(0) 'company ID
            myArray2 = Split(e, "+=+") '2nd split
            For Each e2 In myArray2
                R2.Offset(Rows.Count - R2.Row, 0).End(xlUp).Offset(1, 0) = myCompanyID 'CompanyId to R2
                If j = 0 Then 'judge if 1st e2
                    R2.Offset(Rows.Count - R2.Row, 1).End(xlUp).Offset(1, 0) = Split(e2, "; ")(1) '1st Result of e2 to R2
                Else
                    R2.Offset(Rows.Count - R2.Row, 1).End(xlUp).Offset(1, 0) = e2 'Result to R2
                End If
                j = j + 1
            Next e2
            j = 0
        Next e
        'next cell
        i = i + 1
    Loop
End Sub

Thank you. Partially worked. can I get the result on the next page?
I found two issues (1) if there are multiple ";" between "///" then it should consider the first one only and copy up to "///". I got the data up to the second ";".
(2) Secondly if the data is like this "company-1, what;///company2, Star second;" it is showing an error.

 

[HongRu]

Thank you. Partially worked. can I get the result on the next page?
I found two issues (1) if there are multiple ";" between "///" then it should consider the first one only and copy up to "///". I got the data up to the second ";".
(2) Secondly if the data is like this "company-1, what;///company2, Star second;" it is showing an error.

In my code, I just use "; " (note: there is a space behind ";") for judging "CompanyID", not splitting.
In your sample, the spilt signs seems "///" and "+=+", not "; ".
We should define clearly about the rules of splitting.


I didn't find any error while data without "///".


You can get the reult wherever you like.
Just amend the line below

Set R2 = Range("C2")

for example, if you have a worksheet named "Result"

Set R2 = Worksheets("Result").Range("C2")

 

[sr1111]

I found two issues (Otherwise I have to clean the data manually before running the VBA)
(1) if there are multiple ";" then it should consider the first one only. I got the text before the second ";" (I mean I have not got the complete text because of second or third ";").
(2) Secondly if the data is like this "company-1, what;///company2, Star second;" it is showing an error.

 

[HongRu]

I found two issues (Otherwise I have to clean the data manually before running the VBA)
(1) if there are multiple ";" then it should consider the first one only. I got the text before the second ";" (I mean I have not got the complete text because of second or third ";").
(2) Secondly if the data is like this "company-1, what;///company2, Star second;" it is showing an error.

mmm...I can't catch precisely your idea.
English is not my native language.

My code runs out the result exactly as your output3.

Maybe you can provide another sample and output with more data for all kind of situations by xl2bb.

 

[sr1111]

mmm...I can't catch precisely your idea.
English is not my native language.

My code runs out the result exactly as your output3.

Maybe you can provide another sample and output with more data for all kind of situations by xl2bb.

Input

test.xlsx
	A	B
1	CompanyID	Unique ID
2	Company, id*; ¤¤¤Communications Media, http://www.Communications.com/Media///Company, id*;///Company, id*;	1@#$%2company
3	Company, id*1; ¤¤¤enter fr gic an, ght cer tit, reo th and ce ersit, and, p0 99, 9A. c e:9k@o.u.+=+enter fr gic an, ght cer tit, reo th and ce ersit, and, p0 99, 9A. c e:9k@o.u.+=+enter fr gic an, ght cer tit, reo th and ce ersit, and, p0 99, 9A. c e:9k@o.u..///Company, Name 33T; ¤¤¤enter fr gic an, ght cer tit, reo th and ce ersit, and, p0 99, 9A. c e:9k@o.u.; ¤¤¤enter fr gic an, ght cer tit, reo th and ce ersit, and, p0 99, 9A. c e:9k@o.u.///Company, Name 33T; Company, Name 33T;¤¤¤enter fr gic an, ght cer tit, reo th and ce ersit, and, p0 99, 9A. c e:9k@o.u.; ¤¤¤enter fr gic an, ght cer tit, reo th and ce ersit, and, p0 99, 9A. c e:9k@o.u.///Company, id*;///Company, id*	1@#$%3a
4	id, comi;///com, id;///com, id;	1@#$%4b
5	id, comi;id, comi;id, comi;id, comi;id, comi;///com, id;///com, id;	1@#$%5c
6	id, comi;///===id, comi;///	1@#22$%5c
7	===id, comi12;///	1@#22$%6c
8	===id, comi13;	1@#22$% 7c
9
10	===id, comi13
Sheet1

Result

test.xlsx
	A	B	C
1	CompanyID	Result	Unique ID
2	Company, id*	¤¤¤Communications Media, http://www.Communications.com/Media	1@#$%2company
3	Company, id*		1@#$%2company
4	Company, id*		1@#$%2company
5	Company, id*1	¤¤¤enter fr gic an, ght cer tit, reo th and ce ersit, and, p0 99, 9A. c e:9k@o.u.	1@#$%3a
6	Company, id*1	enter fr gic an, ght cer tit, reo th and ce ersit, and, p0 99, 9A. c e:9k@o.u.	1@#$%3a
7	Company, id*1	enter fr gic an, ght cer tit, reo th and ce ersit, and, p0 99, 9A. c e:9k@o.u..	1@#$%3a
8	Company, Name 33T	¤¤¤enter fr gic an, ght cer tit, reo th and ce ersit, and, p0 99, 9A. c e:9k@o.u.; ¤¤¤enter fr gic an, ght cer tit, reo th and ce ersit, and, p0 99, 9A. c e:9k@o.u.	1@#$%3a
9	Company, Name 33T	Company, Name 33T;¤¤¤enter fr gic an, ght cer tit, reo th and ce ersit, and, p0 99, 9A. c e:9k@o.u.; ¤¤¤enter fr gic an, ght cer tit, reo th and ce ersit, and, p0 99, 9A. c e:9k@o.u.	1@#$%3a
10	Company, id*		1@#$%3a
11	Company, id*		1@#$%3a
12	id, comi		1@#$%4b
13	com, id		1@#$%4b
14	com, id		1@#$%4b
15	id, comi	id, comi;id, comi;id, comi;id, comi;	1@#$%5c
16	com, id		1@#$%5c
17	com, id		1@#$%5c
18	id, comi		1@#22$%5c
19		===id, comi	1@#22$%5c
20		===id, comi12	1@#22$%6c
21		===id, comi13	1@#22$% 7c
22		===id, comi13
Result1