Text to columns then consolidated into one column

[aka_krakur]

I have a column of data that is not consistent except for codes are separated by a semicolon. Up until now I manually convert text to table by separating by semicolon in Data, Text to columns in excel.
then I have to do a bunch of sorting becuase end result I need all these codes into one column. I have pasted below the examples and then finally the end result that I need.

Book2
	A	B	C	D	E	F
1	REPORTED_DEV_CLARIFICATION	REPORTED_DEV_CLARIFICATION1	REPORTED_DEV_CLARIFICATION2	REPORTED_DEV_CLARIFICATION3	REPORTED_DEV_CLARIFICATION4	REPORTED_DEV_CLARIFICATION5
2	1393-N/A;1528-FilterBasket;	1393-N/A	1528-FilterBasket
3	1586-Core;2578-N/A;	1586-Core	2578-N/A
4	1586-Tip;	1586-Tip
5	2578-DeviceComponent;	2578-DeviceComponent
6	2578-Stent;	2578-Stent
7	1528-FilterBasket;1586-Core;1586-FilterBasket;2578-FilterBasket;1670-AgainstResistance;	1528-FilterBasket	1586-Core	1586-FilterBasket	2578-FilterBasket	1670-AgainstResistance
8	1339-Tip;	1339-Tip
9	1339-Shaft;1467-IntroducerSheath;	1339-Shaft	1467-IntroducerSheath
Sheet1

END RESULT

Book2
	A	B	C	D
13	REPORTED_DEV_CLARIFICATION
14	1393-N/A
15	1586-Core
16	1586-Tip
17	2578-DeviceComponent
18	2578-Stent
19	1528-FilterBasket
20	1339-Tip
21	1339-Shaft
22	1528-FilterBasket
23	2578-N/A
24	1586-Core
25	1467-IntroducerSheath
26	1586-FilterBasket
27	2578-FilterBasket
28	1670-AgainstResistance
Sheet1

Can someone help me with this...possibly a macro that loops until all codes in Column A are separated by semicolon then put on their own distinctive row into one column.

Thanks

 

[pgc01]

Hi aka_krakur

Please try:

Sub SplitDev()
Dim lrow As Long, rCell As Range, vDev

Columns("B").Insert
Range("A1").Copy Destination:=Range("B1")
lrow = 2
For Each rCell In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
    For Each vDev In Split(rCell, ";")
        If Trim(vDev) <> "" Then
            Range("B" & lrow).Value = Trim(vDev)
            lrow = lrow + 1
        End If
    Next vDev
Next rCell
Columns("A").Delete
End Sub

Hope this helps
PGC

 

[aka_krakur]

Thanks, looks like it worked. I have to validate by doing it manually; but it looks good.

This might be asking a lot; but before the codes are broken up and separated and put under one column, would there be a way to associate another column with the month-year as there is another column that lists what month-year (MMM-YY) the code happened in.
Here's an example:

Book4
	N	O	P	Q
1	MONTH_SORT	REPORTED_DEVICE_CODE
2	Jan-06	2524;
3	Feb-06	2524;
4	Feb-06	1393;1528;
5	Mar-06	1586;2578;
6	Mar-06	1586;
7	Apr-06	2578;
8	May-06	2524;
9	May-06	1601;
10	Jun-06	2578;
11	Jun-06	2578;
12	Jun-06	X100;
13	Jun-06	1528;1586;1586;2578;1670;
Sheet1

I know the codes look different; but this is how they truly are. (Still separated by Semicolon. Now I would need them still separated but still associated with they're month-year.
Here's how I would need the end result. (Verified by manual process)

Book5
	P	Q	R	S
1	MONTH_SORT	REPORTED_DEVICE_CODE
2	1/1/2006	2524
3	2/1/2006	2524
4	2/1/2006	1393
5	3/1/2006	1586
6	3/1/2006	1586
7	4/1/2006	2578
8	5/1/2006	2524
9	5/1/2006	1601
10	6/1/2006	2578
11	6/1/2006	2578
12	6/1/2006	X100
13	6/1/2006	1528
14	2/1/2006	1528
15	3/1/2006	2578
16	6/1/2006	1586
17	6/1/2006	1586
18	6/1/2006	2578
19	6/1/2006	1670
Sheet1

 

[pgc01]

Hi

What are the values in the column N.

is Jan-06

- a text "Jan-06"
or
- an excel date like 2006-01-01 with a custom format string "mmm-yy"

Kind regards
PGC

 

[aka_krakur]

IT IS A DATE FORMAT JAN-06 = 1/1/06

 

[pgc01]

Hi again

Assuming the MONTH_SORT in column A and the REPORTED_DEVICE_CODE in column B, try:

Sub SplitDev()
Dim lrow As Long, rCell As Range, vDev

Columns("C:D").Insert
Range("A1:B1").Copy Destination:=Range("C1")
lrow = 2
For Each rCell In Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each vDev In Split(rCell, ";")
        If Trim(vDev) <> "" Then
            Range("C" & lrow).Value = rCell.Offset(, -1)
            Range("D" & lrow).Value = Trim(vDev)
            lrow = lrow + 1
        End If
    Next vDev
Next rCell
Columns("A:B").Delete
End Sub

Hope this helps
PGC

 

[aka_krakur]

WORKS LIKE A CHARM...THANKS!!
Only glitch that is mainly cosmetic. Is my data starts on row 19 (well, actually headers start on row 18)
I tried changing some of the values but can't get it right...any more suggestions?

 

[pgc01]

Hi

Assuming the MONTH_SORT in column A and the REPORTED_DEVICE_CODE in column B, with the headers in row 18 and the data starting in row 19, try:

Sub SplitDev()
Dim lrow As Long, rCell As Range, vDev

Columns("C:D").Insert
Range("A18:B18").Copy Destination:=Range("C18")
lrow = 19
For Each rCell In Range("B19:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each vDev In Split(rCell, ";")
        If Trim(vDev) <> "" Then
            Range("C" & lrow).Value = rCell.Offset(, -1)
            Range("D" & lrow).Value = Trim(vDev)
            lrow = lrow + 1
        End If
    Next vDev
Next rCell
Columns("A:B").Delete
End Sub

Hope this helps
PGC

 

[aka_krakur]

Thanks, you've been a big help....it's going from taking like 4 hours to 10 seconds!!! awesome!!!

Any chance you can take a look at my other Post on the Excel Board

http://www.mrexcel.com/board2/viewtopic.php?t=257895

I'm having a heck of a time trying to extract dates from a text string (well, if you read, I've accomplished it sort of, but when there's multiple dates having problems).