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

 

[HongRu]

Pardon me.
I can't figure out what your rules of splitting are.

 

[sr1111]

Pardon me.
I can't figure out what your rules of splitting are.

Extra, in the Input Sheet, I have added a "Unique ID" column in B.
Anyway, Thank you very much.

 

[kvsrinivasamurthy]

Code to get output3

Sub Split_Text()
Dim A, M, N
Dim Lr As Long, T As Long, Ta As Long

Lr = Range("A" & Rows.Count).End(xlUp).Row
A = Sheets("Sheet1").Range("A2:A" & Lr)
With Sheets("Sheet2")
.Range("A1") = "Result"
For T = 1 To UBound(A, 1)
A(T, 1) = Replace(A(T, 1), "+=+", "///" & Left(A(T, 1), InStr(1, A(T, 1), "; ") + 2))
M = ""
M = Split(A(T, 1), "///")
    For Ta = 0 To UBound(M)
    N = ""
    N = Split(M(Ta), "; ")
    .Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Resize(1, UBound(N) + 1) = N ' Application.Transpose(M)
    Next Ta
Next T
End With
End Sub

 

[rlv01]

Pardon me.
I can't figure out what your rules of splitting are.

Neither can I.

 

[sr1111]

Thank you

kvsrinivasamurthy​

And In sheet1/column B, I have a unique ID in the respective row as well. If a unique ID is available in a row cell, how to copy that into the output? I want to see from which ID the results are appearing.

 

[sr1111]

And In sheet1/column B, I have a unique ID in the respective row as well. If a unique ID is available in a row cell, how to copy that into the output? I want to see from which ID the results are appearing.

Pardon me.
I can't figure out what your rules of splitting are.

 

[kvsrinivasamurthy]

If unique ID is available is it to be copied all the split rows . Pl paste a image or mini sheet showing how is data and expected result.

 

[sr1111]

If unique ID is available is it to be copied all the split rows . Pl paste a image or mini sheet showing how is data and expected result.

Here iit is:

Input:

test111.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 1@# $%3a 1@# $%3a
4	id, comi;///com1, id;///com22, id;	1@#$%4b 1@#$%4b
5	id, comi;///===id, comi;///	1@#22$%6c
Sheet1

Output:

test111.xlsx
	A	B	C
1	Result	other	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 1@# $%3a 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 1@# $%3a 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 1@# $%3a 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 1@# $%3a 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 1@# $%3a 1@# $%3a
10	Company, Name 33T		1@# $%3a 1@# $%3a 1@# $%3a
11	Company, Name 33T		1@# $%3a 1@# $%3a 1@# $%3a
12	Company, id*		1@# $%3a 1@# $%3a 1@# $%3a
13	Company, id*		1@# $%3a 1@# $%3a 1@# $%3a
14	id, comi		1@#$%4b 1@#$%4b
15	com1, id		1@#$%4b 1@#$%4b
16	com22, id		1@#$%4b 1@#$%4b
17	id, comi		1@#22$%6c
18	===id, comi		1@#22$%6c
Sheet2

 

[kvsrinivasamurthy]

There is some problem with A3 value. There are only # numbers of "Company, Name 33T". Expected result shows $ numbers and "///" are missing.
Code:

Sub Split_Text()
Dim A, M
Dim Lr As Long, T As Long, Ta As Long, Ro As Long, Cnt As Long

Lr = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
A = Sheets("Sheet1").Range("A2:B" & Lr)
With Sheets("Sheet2")
.Range("A1").CurrentRegion.Clear
.Range("A1") = "Result"
For T = 1 To UBound(A, 1)
A(T, 1) = Replace(A(T, 1), "+=+", "///" & Left(A(T, 1), InStr(1, A(T, 1), "; ") + 2))
M = ""
M = Split(A(T, 1), "///")
    For Ta = 0 To UBound(M)
    If M(Ta) <> "" Then
    Cnt = InStr(1, M(Ta), ";")                         
        If Cnt > 0 Then                                
        Ro = .Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
        .Range("A" & Ro & ":C" & Ro).NumberFormat = "@"
        .Range("A" & Ro) = Trim(Left(M(Ta), Cnt - 1))  
        .Range("B" & Ro) = Trim(Mid(M(Ta), Cnt + 1))
        .Range("C" & Ro) = A(T, 2)
        End If
    End If
    Next Ta
Next T
End With
End Sub