Text to columns, multiple spaces and columns

[leebauman]

Hello, I need to extract what is in B2 to reorganize only information to the right and one space ahead of each "X". Example below.

Any help is much appreciated!

Sample data:

Book1
	A	B
1	Order#	Item
2	12345	2X ABC 3X 123 1X Apple 6X Banana 9X Dog
Sheet1

Desired output:

Book1
	A	B
1	Order #	Item
2	12345	ABC
3	12345	123
4	12345	Apple
5	12345	Banana
6	12345	Dog
Sheet2

 

[Fluff]

How about

+Fluff 1.xlsm
	A	B	C	D	E
1	Order#	Item
2	12345	2X ABC 3X 123 1X Apple 6X Banana 9X Dog		12345	ABC
3				12345	123
4				12345	Apple
5				12345	Banana
6				12345	Dog
7
Master

Cell Formulas
Range	Formula
D2:D6	D2	=IF(E2#<>"",A$2,"")
E2:E6	E2	=FILTERXML("<k><m>"&SUBSTITUTE(SUBSTITUTE(B2,"X ","</m><x>")," ","</x><m>")&"</x></k>","//x")
Dynamic array formulas.

 

[leebauman]

That works on the sample data, but not on my broader set which includes thousands of orders and item sets. Here's a better example:

Sample data:

Book3
	A	B
1	Order#	Item
2	12345	2X ABC 3X 123 1X Apple 6X Banana 9X Dog
3	98765	3X Pear 2X Orange
4	11111	2X Lemon
5	22222	8X Almond 3X Walnut
Sheet1

Desired output:

Book3
	A	B
1	Order#	Item
2	12345	ABC
3	12345	123
4	12345	Apple
5	12345	Banana
6	12345	Dog
7	98765	Pear
8	98765	Orange
9	11111	Lemon
10	22222	Almond
11	22222	Walnut
Sheet2

Thank you!

 

[lrobbo314]

You can try this VBA solution. Running it will turn this...

Book1 (version 2).xlsb
	A	B
1	Order#	Item
2	12345	2X ABC 3X 123 1X Apple 6X Banana 9X Dog
3	98765	3X Pear 2X Orange
4	11111	2X Lemon
5	22222	8X Almond 3X Walnut
Sheet3

into this...

Book1 (version 2).xlsb
	A	B
1	Order#	Item
2	12345	ABC
3	12345	123
4	12345	Apple
5	12345	Banana
6	12345	Dog
7	98765	Pear
8	98765	Orange
9	11111	Lemon
10	22222	Almond
11	22222	Walnut
Sheet3

Sub SPLITX()
Dim r As Range:         Set r = Range("A2:B" & Range("A" & Rows.Count).End(xlUp).Row)
Dim AR() As Variant:    AR = r.Value2
Dim AL As Object:       Set AL = CreateObject("System.Collections.ArrayList")
Dim SP() As String
Dim tmp As String

With CreateObject("VBScript.RegExp")
    .Global = True
    .Pattern = "(\s?\dX\s)"
    For i = LBound(AR) To UBound(AR)
        tmp = .Replace(AR(i, 2), "@")
        SP = Split(tmp, "@")
        For j = 1 To UBound(SP)
            AL.Add AR(i, 1) & ";" & SP(j)
        Next j
    Next i
End With

r.ClearContents

With Range("A2").Resize(AL.Count, 1)
    .Value = Application.Transpose(AL.toArray)
    .TextToColumns DataType:=xlDelimited, semicolon:=True
End With
End Sub

 

[leebauman]

I get an error when I run the Macro. Am I entering the VBA incorrectly? Thanks.

 

[lrobbo314]

Probably means you don't have .Net Framework installed on your computer. Try this instead.

Sub SPLITX()
Dim r As Range:         Set r = Range("A2:B" & Range("A" & Rows.Count).End(xlUp).Row)
Dim AR() As Variant:    AR = r.Value2
Dim SD As Object:       Set SD = CreateObject("Scripting.Dictionary")
Dim SP() As String
Dim tmp As String

With CreateObject("VBScript.RegExp")
    .Global = True
    .Pattern = "(\s?\dX\s)"
    For i = LBound(AR) To UBound(AR)
        tmp = .Replace(AR(i, 2), "@")
        SP = Split(tmp, "@")
        For j = 1 To UBound(SP)
            SD.Add AR(i, 1) & ";" & SP(j), 1
        Next j
    Next i
End With

r.ClearContents

With Range("A2").Resize(SD.Count, 1)
    .Value = Application.Transpose(SD.keys())
    .TextToColumns DataType:=xlDelimited, semicolon:=True
End With
End Sub

 

[leebauman]

That works perfectly. Thank you@!

 

[lrobbo314]

───────────────────░█▓▓▓█░▇▆▅▄▃▂
──────────────────░█▓▓▓▓▓█░▇▆▅▄▃▂
─────────────────░█▓▓▓▓▓█░▇▆▅▄▃▂
──────────░░░───░█▓▓▓▓▓▓█░▇▆▅▄▃▂
─────────░███░──░█▓▓▓▓▓█░▇▆▅▄▃▂
───────░██░░░██░█▓▓▓▓▓█░▇▆▅▄▃▂
──────░█░░█░░░░██▓▓▓▓▓█░▇▆▅▄▃▂
────░██░░█░░░░░░█▓▓▓▓█░▇▆▅▄▃▂
───░█░░░█░░░░░░░██▓▓▓█░▇▆▅▄▃▂
──░█░░░░█░░░░░░░░█▓▓▓█░▇▆▅▄▃▂
──░█░░░░░█░░░░░░░░█▓▓▓█░▇▆▅▄▃▂
──░█░░█░░░█░░░░░░░░█▓▓█░▇▆▅▄▃▂
─░█░░░█░░░░██░░░░░░█▓▓█░▇▆▅▄▃▂
─░█░░░░█░░░░░██░░░█▓▓▓█░▇▆▅▄▃▂
─░█░█░░░█░░░░░░███▓▓▓▓█░▇▆▅▄▃▂
░█░░░█░░░██░░░░░█▓▓▓▓▓█░▇▆▅▄▃▂
░█░░░░█░░░░█████▓▓▓▓▓█░▇▆▅▄▃▂
░█░░░░░█░░░░░░░█▓▓▓▓▓█░▇▆▅▄▃▂
░█░█░░░░██░░░░█▓▓▓▓▓█░▇▆▅▄▃▂
─░█░█░░░░░████▓▓▓▓██░▇▆▅▄▃▂
─░█░░█░░░░░░░█▓▓██▓█░▇▆▅▄▃▂
──░█░░██░░░██▓▓█▓▓▓█░▇▆▅▄▃▂
───░██░░███▓▓██▓█▓▓█░▇▆▅▄▃▂
────░██▓▓▓███▓▓▓█▓▓▓█░▇▆▅▄▃▂
──────░█▓▓▓▓▓▓▓▓█▓▓▓█░▇▆▅▄▃▂
──────░█▓▓▓▓▓▓▓▓▓▓▓▓▓█░▇▆▅▄▃▂