Separating delimited text in one cell, then associating with delimited text in adjacent cell

[Hockeynow70]

Greetings all,

I hope you can help me. I have a case where I have a list of part numbers grouped in one cell. In the cell next to that is list of revisions, grouped in the same respective order as the part numbers. Each part number and respective revision are separated by the delimiter, "|". There are an indefinite number of rows, each with an indefinite number of groupings. For example:

[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD]Part Number[/TD]
[TD]Revision[/TD]
[/TR]
[TR]
[TD]LF001535_PORT1|00001534-10|00079273 W|00079274[/TD]
[TD]00|C|--|D[/TD]
[/TR]
[TR]
[TD]0029079|000778625[/TD]
[TD]01|A[/TD]
[/TR]
</tbody>[/TABLE]


The color coding indicates the Part Number / Revision association.

I would like to convert this into a table that lists and part number in a cell, next to its respective revision, in a vertical array as shown below:

[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD]Part Number[/TD]
[TD]Revision[/TD]
[/TR]
[TR]
[TD]LF001535_PORT1[/TD]
[TD]00[/TD]
[/TR]
[TR]
[TD]00001534-10[/TD]
[TD]C[/TD]
[/TR]
[TR]
[TD]00079273 W[/TD]
[TD]--[/TD]
[/TR]
[TR]
[TD]00079274[/TD]
[TD]D[/TD]
[/TR]
[TR]
[TD]0029079[/TD]
[TD]01[/TD]
[/TR]
[TR]
[TD]000778625[/TD]
[TD]A[/TD]
[/TR]
</tbody>[/TABLE]


Note that there may be any combination of alphanumeric and special characters. Additionally, I need to preserve the format at TEXT so that any leading zeros are preserved, as the number of characters is significant.

If you can solve this riddle for me I would greatly appreciate it! Thank you in advance for your help.

Warm regards,
Chris

 

[hiker95]

Hockeynow70,

Welcome to the MrExcel forum.

What version of Excel and Windows are you using?

I assume that each row pair in columns A and B contain the same number of items separated by the | character.

Sample raw data:

Excel 2007
	A	B	C	D	E	F
1	Part Number	Revision
2	LF001535_PORT1|00001534-10|00079273 W|00079274	00|C|--|D
3	0029079|000778625	01|A
4
5
6
7
8
Sheet1

After the macro using two arrays in memory:

Excel 2007
	A	B	C	D	E	F
1	Part Number	Revision			Part Number	Revision
2	LF001535_PORT1|00001534-10|00079273 W|00079274	00|C|--|D			LF001535_PORT1	00
3	0029079|000778625	01|A			00001534-10	C
4					00079273 W	--
5					00079274	D
6					0029079	01
7					000778625	A
8
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Option Explicit
Sub ReorgData()
' hiker95, 11/14/2013
' http://www.mrexcel.com/forum/excel-questions/739481-separating-delimited-text-one-cell-then-associating-delimited-text-adjacent-cell.html
Dim a As Variant, o As Variant, s1, s2
Dim i As Long, ii As Long, si As Long, n As Long, tn As Long
a = Range("A2:B" & Range("A" & Rows.Count).End(xlUp).Row)
For i = 1 To UBound(a, 1)
  n = Len(a(i, 1)) - Len(Application.Substitute(a(i, 1), "|", "")) + 1
  tn = tn + n
Next i
ReDim o(1 To tn, 1 To 2)
For i = 1 To UBound(a, 1)
  s1 = Split(Trim(a(i, 1)), "|")
  s2 = Split(Trim(a(i, 2)), "|")
  For si = LBound(s1) To UBound(s1)
    ii = ii + 1
    o(ii, 1) = s1(si)
    o(ii, 2) = s2(si)
  Next si
Next i
Columns("E:F").ClearContents
Cells(1, 5).Resize(, 2).Value = Cells(1, 1).Resize(, 2).Value
Cells(2, 5).Resize(UBound(o, 1), UBound(o, 2)).NumberFormat = "@"
Cells(2, 5).Resize(UBound(o, 1), UBound(o, 2)) = o
Columns("E:F").AutoFit
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the ReorgData macro.

 

[Rick Rothstein]

Here is another macro (non-looping) that you can also consider...

Sub SplitDownward()
  Dim LastRow As Long, ColA As String, ColB As String, Arr() As String
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  ColA = Join(WorksheetFunction.Transpose(Range("A1:A" & LastRow).Value), "|")
  ColB = Join(WorksheetFunction.Transpose(Range("B1:B" & LastRow).Value), "|")
  Arr = Split(ColA, "|")
  Range("E1:F" & UBound(Arr) + 1).NumberFormat = "@"
  Range("E1:E" & UBound(Arr) + 1) = WorksheetFunction.Transpose(Arr)
  Arr = Split(ColB, "|")
  Range("F1:F" & UBound(Arr) + 1) = WorksheetFunction.Transpose(Arr)
End Sub

 

[Hockeynow70]

You guys are good. This is a great help. Thank you so much!!

 

[hiker95]

Hockeynow70,

Thanks for the feedback.

You are very welcome. Glad we could help.

And, come back anytime.