Formula or UDF to split a cell value into rows within a new cell

[mnty89]

Hi All,

This is a little too much of a complex vba for me, and I didnt know how to describe it in a concise enough way to google it effectively. Right now it is a very repetitive copy paste, text to columns, transpose, filter process for each cell..

Basically I will get an excel cell value of one long text as in the example below. I want a formula or UDF, or VBA that will loop through the rows that have that long text, and turn it into cleaned up cell like the before and after below-

Before cell

Related PO: SPH Related PO: 0049-1637504-3804 Related PO: 0003-1725849-3804 Related PO: 0253-1982071-3804 Related PO: 0245-2082143-3804 Related PO: 0231-2890617-3804 Related PO: 0052-3375471-3804 Related PO: 0007-3521948-3804 Related PO: 0094-5321648-3804 Related PO: 0037-8544319-3804 Related PO: 0003-8940612-3804 Related PO: 0063-9546192-3804 Related PO: 0212-9684200-3804 Related PO: 0212-9823856-3804

After cell
0049-1637504-3804
0003-1725849-3804
0253-1982071-3804
0245-2082143-3804
0231-2890617-3804
0052-3375471-3804
0007-3521948-3804
0094-5321648-3804
0037-8544319-3804
0003-8940612-3804
0063-9546192-3804
0212-9684200-3804
0212-9823856-3804

 

[MrKowz]

Try this out:

Public Sub CleanString()
Dim ary As Variant
    
ary = Split(" " & Range("A1").Value, " Related PO: ")
Range("A2").Resize(UBound(ary), 1).Value = Application.Transpose(ary)

End Subb

I used the below input (A1) and it spat out the results (beginning in A2). Note, A2 is blank because the string began with our delimeter.

Excel 2013/2016
	A
1	Related PO: SPH Related PO: 0049-1637504-3804 Related PO: 0003-1725849-3804 Related PO: 0253-1982071-3804 Related PO: 0245-2082143-3804 Related PO: 0231-2890617-3804 Related PO: 0052-3375471-3804 Related PO: 0007-3521948-3804 Related PO: 0094-5321648-3804 Related PO: 0037-8544319-3804 Related PO: 0003-8940612-3804 Related PO: 0063-9546192-3804 Related PO: 0212-9684200-3804 Related PO: 0212-9823856-3804
2
3	SPH
4	0049-1637504-3804
5	0003-1725849-3804
6	0253-1982071-3804
7	0245-2082143-3804
8	0231-2890617-3804
9	0052-3375471-3804
10	0007-3521948-3804
11	0094-5321648-3804
12	0037-8544319-3804
13	0003-8940612-3804
14	0063-9546192-3804
15	0212-9684200-3804
Sheet1

 

[mnty89]

Wow.. you are fast/a god..

Is there any way to make it format to return the result in one single cell but one under another as opposed to row after row?

 

[MrKowz]

Wow.. you are fast/a god..

Is there any way to make it format to return the result in one single cell but one under another as opposed to row after row?

Try:

Public Sub CleanString2()
Range("A2").Value = Replace(" " & Range("A1").Value, " Related PO: ", vbLf)
End Sub

 

[Rick Rothstein]

Assuming your single example is truly representative of your actual data, you can also do what you want with a formula...

=SUBSTITUTE(MID(SUBSTITUTE(SUBSTITUTE(A1,": ",":")," Related PO",""),16,LEN(A1)),":",CHAR(10))

 

[mnty89]

embarrassed to ask, but since it will take you 1 minute and me an hour to figure it out..

Can you tweak the second answer to start with A1, output into B1, and run as a loop until there are no more values in A?

I think it's a matter of declaring it as a variable and do until x= "" or something?

 

[Rick Rothstein]

Can you tweak the second answer to start with A1, output into B1, and run as a loop until there are no more values in A?

I am not clear which of these you want, so if the first is wrong, then try the second one...

[table="width: 500"]
[tr]
	[td]Sub CleanStrings()
  Dim Cell As Range, Ary As Variant
  For Each Cell In Columns("A").SpecialCells(xlConstants)
    Cell.Offset(, 1).Value = Replace(Mid(Cell.Value, InStr(Cell.Value, ":") + 2), " Related PO: ", vbLf)
  Next
End Sub[/td]
[/tr]
[/table]

[table="width: 500"]
[tr]
	[td]Sub CleanStrings()
  Dim Cell As Range, Ary As Variant
  For Each Cell In Columns("A").SpecialCells(xlConstants)
    Ary = Split(Mid(Cell.Value, InStr(Cell.Value, ":") + 2) & " Related PO: ", " Related PO: ")
    Cell.Offset(, 1).Resize(, UBound(Ary)).Value = Application.Index(Ary, 1, 0)
  Next
End Sub[/td]
[/tr]
[/table]