Text-to-columns-like (probably) VBA script

Greetings all,

I have a raw data sheet that looks like this:

Screen Shot 2016-05-19 at 10.28.49 .png

I want to parse out the data in A, which is separated by comma/space to new rows, while duplicating information in other columns, like this:

Screen Shot 2016-05-19 at 10.32.41 .png

I'm fairly adept at non-VBA functionality, but beyond importing the data into Access (which I also don't know how to do), this is bewildering on how to accomplish.

I'm grateful to any help. Cheers!

Hi,

Attach a sample workbook. Make sure there is just enough data to demonstrate your need. Include a BEFORE sheet and an AFTER sheet in the workbook if needed to show the process you're trying to complete or automate. Make sure your desired results are shown, mock them up manually if necessary.

Remember to desensitize the data.

Click on GO ADVANCED and then scroll down to Manage Attachments to open the upload window (or use the paperclip icon).

Does it have to be VBA? If I understand what you are trying to do (Parse the text at the commas and only keep the first "column"), I would use the built in Text to Columns command.

1) Select column A
2) Text to Columns
3) Delimited with comma as the delimiter
4) Skip 2nd and subsequent columns
5) Finish.

Does that work for you? If not, I would suggest that you explain why you cannot use the built in utility so we can better understand your requirements.

I need the rest of the columns intact; i.e., kept in relation to the serials. Also, There may be 1, 3, 10 or more serials in the Serials column, so I need the data in subsequent columns (the live sheet has ~15 columns) to repeat per serial that's broken out via text-to-columns-like functionality. It could look like this:

Screen Shot 2016-05-19 at 11.06.10 .png

To this:

Screen Shot 2016-05-19 at 11.07.12 .png

Finally, the live sheet has other columns in which there are multiple values. Ideally, those would be parsed also, creating duplicate rows for the entire sheet, until no cell had multiple data. For now, a good compromise would be to parse out a single column.

Make sense?

Disclaimer: I don't do much "database" work like this, so I am not familiar with the tools and such that go into something like this.

The basic task seems to be to identify records that are actually multiple records, then separate them out into multiple records. Here's how my inexperienced brain sees this occuring.

1) Read a record and identify how many records it actually contains.
2) Split (Maybe by using the Split() function https://msdn.microsoft.com/en-us/lib.../gg278528.aspx ) the fields that need to be split into separate values.
3) Write each record to the spreadsheet.

I'm not exactly sure how I would approach each step. Is there a specific part that you need help with, or do you need the entire thing?

Mr. Shorty has your solution in post #6:

Read the field, split on comma-space, insert UBound rows and fill with "splittees" repeat until you reach a null field.

Had you posted your workbook as Richard suggested, I may have been able to write this for your Excel part

I could do it in steps--write one column at a time (with the multiple values separated), then attack subsequent columns. For now, I'd be happy with just one column processed.

I'm not sure it is that easy, because there would be some "integration" steps that seem difficult if you process one column/field at a time. It seems to me that it will be best to process one record at a time, but that is just me.

Processing a column seems easy. Pseudocode:

For each roworcell in column
array=split(roworcell.value,",")
For i=0 to ubound(array)
destinationcell.value=array(i)
'Since I think it will be easier to process the entire record, write the rest of record into adjacent columns to destinationcell
next i
next roworcell

Hi Jimbosi,

Try this:

Sub Jimbosi(): Dim r As Long, n As Long, X: r = 2
Splitem:
If Range("A" & r) = "" Then Exit Sub
X = Split(Range("A" & r), ", ")
If UBound(X) Then
Range("A" & r + 1).Resize(UBound(X), 4).Insert
Range("A" & r) = X(0)
For n = 1 To UBound(X)
Range("A" & r + n) = X(n)
Range("B" & r + n).Resize(1, 3).Value = _
Range("B" & r).Resize(1, 3).Value: Next n
r = r + n - 1: End If
r = r + 1: GoTo Splitem
End Sub

Can you modify the code to accommodate variable numbers of columns? The output looks like this when columns are added:

Screen Shot 2016-05-20 at 13.35.55 .png

The subsequent columns don't copy over.

In the live data, I won't necessarily know the number of columns, so the script should just go to the last column with data, whatever that is. Tks for looking!

Also, I'm guessing this isn't possible without VBA, right?

I expect it is possible without VBA. At worst, you can just do it manually. Automated, it is about performing the same steps or actions - count how many actual records are in each row, then parse the data and arrange it into a database like table. I think a lot of it would be =INDEX() functions, coupled with formulas to keep track of row/column # while processing. This would be an operation where I would like to see Excel have a =SPLIT() function like Google docs has. Definitely doable, if you are willing to spend the time to figure out each step.

As far as changing xladept's code, it should be able to work on any column or multiple columns, you just need to specifiy the correct column letter in each Range() object.

Hi jimbosi,

You're welcome and thanks for the rep!

I would just copy the input data to a new sheet and then run the program on the copy.

Where would the column to parse be? You'd have to assign the surrounding columns.

Just post another sample and I can modify the code

Edited I forgot to include the second formula in the original post. My apologies.

Another approach.

I don't know about database either. It appears that if you can find a way to concatenate the Serial column you're home free. The only way I know of to do that is with VBA. There in a UDF here

http://www.excelforum.com/tips-and-t...ml#post3096647

Once concatenated I managed to do the rest with this array-entered formula in A2 and filled down (note: Personal.xlsb! is part of this formula because that is where I store my copy. If the UDF is in a module with your file that part needs to be deleted from this formula.)

=TRIM(MID(SUBSTITUTE(Personal.xlsb!concatall('raw data'!$A$2:$A$4,", "),", ",REPT(" ",256)),(ROWS('raw data'!$1:1)-1)*256+1,256))


If you aren’t familiar with array-entered formulas array enter means the formula must be committed from edit mode by simultaneously pressing and holding down Ctrl and Shift while hitting Enter.

Then this array-entered formula in B2 filled down and across. (The second formula.)

=INDEX('raw data'!B$2:B$4,MATCH("*"&$A2&"*",'raw data'!$A$2:$A$4&"",0))

	A	B	C	D
1	Serial	Date	Customer	Grade
2	1234	1-Jan-16	ABC	A
3	4567	1-Jan-16	ABC	A
4	2345	4-Feb-16	DCE	B
5	5678	5-Mar-16	ABC	C
6	6789	5-Mar-16	ABC	C

Originally Posted by jimbosi

What would the output look like in a concatenated Serial column? There are already multiple values in the cell. I guess I don't understand what concatenating would do in this instance. TIA for the help.

Assuming that was directed to me, that formula concatenates all the column into a single string (in memory I forgot mention that part), parses that string into a one-dimension array of all Serial. It then returns each of those parsed Serials from that array.

Sub M_snb()
   sn = Sheets("raw data").Cells(1).CurrentRegion
   
   With CreateObject("scripting.dictionary")
      For j = 2 To UBound(sn)
        sp = Split(sn(j, 1), ",")
        sq = Application.Index(sn, j)
        For jj = 0 To UBound(sp)
          sq(1) = Trim(sp(jj))
          .Item(.Count) = sq
        Next
      Next

      Sheets("desired result").Cells(1).Resize(.Count, UBound(sn, 2)) = Application.Index(.items, 0, 0)
   End With
End Sub

If the column 'serial' always contains the items that have to be split:

Sub M_snb()
   sn = Sheets("raw data").Cells(1).CurrentRegion
   y = Application.Match("Serial", Sheets("raw data").Rows(1), 0)
   
   With CreateObject("scripting.dictionary")
      For j = 2 To UBound(sn)
        sp = Split(sn(j, y), ",")
        sq = Application.Index(sn, j)
        For jj = 0 To UBound(sp)
          sq(y) = Trim(sp(jj))
          .Item(.Count) = sq
        Next
      Next

      Sheets("desired result").Cells(1).Resize(.Count, UBound(sn, 2)) = Application.Index(.items, 0, 0)
   End With
End Sub

@snb - That's elegant code, wish I understood it.

@Jimbosi - I've dimensioned snb's code in case you're running Option Explicit - Do you need Headers on the desired results?

Sub M_snb(): Dim SN, y As Long, j As Long, jj As Long, sp, sq
   SN = Sheets("raw data").Cells(1).CurrentRegion
   y = Application.Match("Serial", Sheets("raw data").Rows(1), 0)
   
   With CreateObject("scripting.dictionary")
      For j = 2 To UBound(SN)
        sp = Split(SN(j, y), ",")
        sq = Application.Index(SN, j)
        For jj = 0 To UBound(sp)
          sq(y) = Trim(sp(jj))
          .Item(.count) = sq
        Next
      Next

      Sheets("desired result").Cells(1).Resize(.count, UBound(SN, 2)) = _
      Application.Index(.items, 0, 0)
   End With
End Sub

Part of the explanation you will find here: http://www.snb-vba.eu/VBA_Dictionary_en.html

Please, do not post pictures. Upload files instead.

@ snb - You taught me about the dictionary collection a couple of years ago, I'm puzzling over the use of index

@ jimbosi - I've further modified snb's code - it seems to be working nicely

Sub M_snb(): Dim SN, y As Long, j As Long, jj As Long, sp, sq

   SN = Sheets("raw data").UsedRange
   y = Application.Match("Serial", Sheets("raw data").Rows(1), 0)
   
   With CreateObject("scripting.dictionary")
      For j = 1 To UBound(SN)
        sp = Split(SN(j, y), ",")
        sq = Application.Index(SN, j)
        For jj = 0 To UBound(sp)
          sq(y) = Trim(sp(jj))
          .Item(.count) = sq
        Next
      Next

      Sheets("desired result").Cells(1).Resize(.count, UBound(SN, 2)) = _
      Application.Index(.items, 0, 0)
   End With
End Sub

Hi jimbosi,

In case that was meant for me, here's the file with the code in module 1.

Please do not use 'adepted' code


NB If your 'office' version doesn't contain the scripting runtime library you are in -self inflicted- trouble

@ snb - What's wrong with the adepted code? It works? I'd like to learn from this

@ jimbosi - Ran like a charm

Have you set a reference to the the scripting runtime library?

{Alt+F11-Tools-References and check Microsoft Scripting Runtime}

@Jim
You must have modified the code.
If you hadn't, it would have given you the desired results.

@p45cal

No reference to the library necessary, because we use late binding: Createobject("scripting.dictionary")

Application index considers the array '.items' as an array of which all rows ,0 and all columns (because each item in the dictionary is an array itself;in other words the dictionary is a dictionary of arrays) ,0 should be taken into account:

i.e application.index(.items,0,0)

Introducing the declarations can introduce mistakes.
The code runs perfectly well without any declaration. All variables will be considered to be variants and that is perfectly fine.
So why introducing a mistake prone behavior that is also 100% redundant ?

@snb - Well I disagree, but that's an intriguing point of view - the vast majority of us are not as accomplished as are you

Originally Posted by xladept

@snb - Well I disagree, but that's an intriguing point of view - the vast majority of us are not as accomplished as are you

Redundancy and proficiency are not related

@snb - thanks for the explanation, I'd been looking at your "smarties" arrays and saw it almost used there - I saw: index(.item,1,0) - (I think)

Many of us use Option Exlplicit so we have to declare even variants - are you telling jimbosi to dump the Option Explicit?

@ jimbosi - If you can't get snb's code to work for you, shall I write an extension of my earlier submission?

@xladept

I can only conclude that declaring any variable in this case is 100% redundant (serves no purpose).
So consequently 'option explicit' shouldn't be introduced, should be removed, or commented out.

Hi Jimbosi,

The error 9 could be because you haven't got the book active?

I'll do something along my original version tomorrow

Well, it suffers from elegance but it may work for you:

Sub Jimbosi(): Dim r As Long, n As Long, c As Long, k As Long, X: r = 2
Sheets("desired result").Activate
Sheets("desired result").Cells.ClearContents
Sheets("raw data").Cells.Copy Sheets("desired result").Range("A1")

k = 1: Do Until Cells(1, k + 1) = "": k = k + 1: Loop
c = 1: Do Until Cells(1, c) = "Serial": c = c + 1: Loop
Splitem:
If Cells(r, c) = "" Then Exit Sub
X = Split(Cells(r, c), ", ")
If UBound(X) Then
Cells(r + 1, 1).Resize(UBound(X), k).Insert
Cells(r + 1, 1).Resize(UBound(X), k).Value = _
Cells(r, 1).Resize(1, k).Value
Cells(r, c) = X(0)
For n = 1 To UBound(X)
Cells(r + n, c) = X(n)
: Next n
r = r + n - 1: End If
r = r + 1: GoTo Splitem
End Sub

Altruism? Moi? Thanks for the rep!

@ snb - Actually, there may be a negative correlation

Hi, Great Thread, IMVHO , with lots of alternatives .
-1 ) I could not follow Mr Shorty’s instructions sadly, as I guess that may be the best way.

_2 ) Sadly I was lost on the first “concatenating” part from Dave ( FlameRetired) as well ... possibly this was aimed at Dave, as he also suggested: ?

Originally Posted by jimbosi

What would the output look like in a concatenated Serial column? There are already multiple values in the cell. I guess I don't understand what concatenating would do in this instance. TIA for the help.

@ Dave, Post #30 did not take me further, - sorry my ignorance. I cannot see exactly what you are suggesting.

_3) I would love to use snb’s if I ever had the time to understand them. – maybe something to do in a long retirement, later. ( and I agree with Orrin about the Option Explicit, ( but I am too thick to join in on the intellectual discussions on that one ). I know I would get in an even bigger mess when writing codes if I did not use it.

_4) All of Orrin’s code versions are working for me. I changed the last one a bit as I get a bit confused with sheets and codes as I do not always put codes where I should and so the implicitly defaulted Active Sheet thing may be wrong. – giving bad wonks

Here is my version of his code, ( snb’s version working under Option Explicit is also there )
http://www.excelforum.com/showthread...94#post4393994

Orrins’s code, I think, is quite easy to follow if you work your way through..
_....................................

@ jimbosi
_5) Anyway I did another one for the collection. Probably not much different from the others, but maybe a bit easier to understand, if you have the time to go through it!. I see the problem may be you do not have the Microsoft Scripting Runtime Library to get at that Microsoft Scripting Runtime Dictionary? , - that is used in snb’s codes just to get at unique things, serial numbers I guess in this case.
Really my code is just a combination of those given already..
It looks a lot more complicated then it is as I have added a lot of in between steps and a lot of ‘green explaining comments . You can wack off the ‘green explaining comments in one go (_..see for example from Post #7 here: http://www.excelforum.com/showthread...94#post4393994 .._)
And you can remove a lot of Variables and with that there declarations. You do that by substituting in their assigned values directly where the variables are then later used in the code.
I could do that for you if you want, but it would be a good learning exercise for you to do that slowly bit by bit as you follow through

Basically my code is a “VBA Array” version, minimising spreadsheet interaction by capturing the data initially to an Array, doing all the “working” internally – making an Output Array, then pasting out the Output in one go. snb’s does the same, just a lot cleverer! Orrins is a “Spreadsheet interaction” type, and easier to understand when you are learning.

Here is my Code ( and note there are some required functions there : just copy the lot to the same Code Module and run the main code.

Sub AlanWonkySplits()
http://www.excelforum.com/showthread...64#post4394064

_.............

I tried all our codes on the following data.. All gave the same results.. ( Remember when you are testing different data, especially where the Serial column may change, then before each test run, check that you reset your desired result Worksheet format back to standard as any date formatting left over from the last test may give you some weird results )

So using this data

Row\Col	A	B	C	D	E
1	Serial	Date	Customer	Grade
2	1234, 4567	01. Jan 16	ABC	A
3	2345	04. Feb 16	DCE	B
4	5678, 6789	05. Mrz 16	ABC	C
5

raw data

You get this:

Row\Col	A	B	C	D	E
1	Serial	Date	Customer	Grade
2	1234	01.01.2016	ABC	A
3	4567	01.01.2016	ABC	A
4	2345	04.02.2016	DCE	B
5	5678	05.03.2016	ABC	C
6	6789	05.03.2016	ABC	C
7

desired result

_............................

And using this data


Using Excel 2007

Row\Col	A	B	C	D	E	F	G
1	Date	Serial	Customer	Grade	Eval	Author
2	01.01.2016	1234	ABC	A	ljdd	John
3	01.01.2016	4444	ABC	A	lkjd	Joe
4	02.01.2016	5432, 5555	ABC	B	ijkl	Kim
5	03.01.2016	4456	ABC	C	wesd	Mary
6	10.01.2016	2903, 6666, 7777	ABC	A	xcvb	John
7	11.01.2016	4567	ABC	D	eovm	Mary
8	04.02.2016	2345	DCE	B	lkjd	Kim
9

raw data

you get this

Row\Col	A	B	C	D	E	F	G
1	Date	Serial	Customer	Grade	Eval	Author
2	01.01.2016	1234	ABC	A	ljdd	John
3	01.01.2016	4444	ABC	A	lkjd	Joe
4	02.01.2016	5432	ABC	B	ijkl	Kim
5	02.01.2016	5555	ABC	B	ijkl	Kim
6	03.01.2016	4456	ABC	C	wesd	Mary
7	10.01.2016	2903	ABC	A	xcvb	John
8	10.01.2016	6666	ABC	A	xcvb	John
9	10.01.2016	7777	ABC	A	xcvb	John
10	11.01.2016	4567	ABC	D	eovm	Mary
11	04.02.2016	2345	DCE	B	lkjd	Kim
12

desired result

_.....................................................

See how you get on and let us Know please...

Alan

P.s. You might want to consider changing the Thread Title to something like “Split Multiple Column Entries to extra Rows” – That might aid someone in the future on a Google type search to get here

All Magnificent Helpers,

In the live data, the serial looks like this: ########## (10 digits). For
some, there may be only one entry in the cell (1234567890); for other cells,
there may be two or more (1234567890, 9876543211).

In some cells, Serial is blank. The VBA would have to treat that cell without error.

The live sheet has ~14 columns (column N, but may vary).

Sub Jimbosi(): Dim r As Long, n As Long, c As Long, k As Long, X: r = 2 
Sheets("desired result").Activate 
Sheets("desired result").Cells.ClearContents 
Sheets("raw data").Cells.Copy Sheets("desired result").Range("A1") 

k = 1: Do Until Cells(1, k + 1) = "": k = k + 1: Loop 
c = 1: Do Until Cells(1, c) = "Serial": c = c + 1: Loop 
Splitem: 
If Cells(r, c) = "" Then Exit Sub 
X = Split(Cells(r, c), ", ") 
If UBound(X) Then 
Cells(r + 1, 1).Resize(UBound(X), k).Insert 
Cells(r + 1, 1).Resize(UBound(X), k).Value = _ 
Cells(r, 1).Resize(1, k).Value 
Cells(r, c) = X(0) 
For n = 1 To UBound(X) 
Cells(r + n, c) = X(n) 
: Next n 
r = r + n - 1: End If 
r = r + 1: GoTo Splitem 
End Sub

The code successfully copies some data to "desired result."

This code doesn't successfully separate out for me.

I can't include the live sheet, but enclosed is a closer approximation. The
live sheet is ~20000 rows.

The other submitted code errors out Code 13 (mismatch)--only the above code runs without error, but it just seems to copy the data to a new sheet.

I set the topic to SOLVED because my (simplified) test data worked; however,
the provided code (tks!) didn't successfully process, or I have some unknown
perturbation in my data. The serial column is formatted General (although serials without commas stack on the right, and multiples stack on the left.).

@jimbosi, re #48

Your post does not comply with Rule 3 of our Forum RULES. Use code tags around code.

Posting code between [CODE] [/CODE] tags makes your code much easier to read and copy for testing, it also maintains VBA formatting.

Highlight your code and click the # icon at the top of your post window. More information about these and other tags can be found here



(This thread should receive no further responses until this moderation request is fulfilled, as per Forum Rule 7)

Without Dictionary:

Sub M_snb()
   sn = Sheets("raw data").UsedRange
   y = Application.Match("Serial", Sheets("raw data").Rows(1), 0)
   
   For j = 1 To UBound(sn)
      c00 = c00 & Replace(String(UBound(Split(sn(j, y), ",")) + 1, "|"), "|", "|" & j)
      c01 = c01 & "," & sn(j, y)
   Next
   sp = Split(Mid(c00, 2), "|")
   sp = Application.Index(sp, Evaluate("row(1:" & UBound(sp) + 1 & ")"))
   sq = Split(Mid(c01, 2), ",")
   sq = Application.Index(sq, Evaluate("row(1:" & UBound(sq) + 1 & ")"))

   Sheets("desired result").Cells(1).Resize(UBound(sp), UBound(sn, 2)) = Application.Index(sn, sp, Evaluate("column(1:" & UBound(sn, 2) & ")"))
   Sheets("desired result").Cells(1, y).Resize(UBound(sq)) = sq
End Sub

Row\Col	A	B	C	D	E	F	G	H	I	J	K	L
1	Serial	Customer	Organization	Appraisal	Author Date	Receipt Date	Year	Customer2	Title	Grade	Eval	Author
2	1234567890		XYZ	Value	01.01.2016	02.01.2016	2016	ABC	Title1	A	ljdd	John
3	4444111122		ZZZ	High Value	01.01.2016	02.01.2016	2016	ABC	Title2	A	lkjd	Joe
4	5432112233		XYZ	Low Value	02.01.2016	03.01.2016	2016	ABC	Title3	B	ijkl	Kim
5	5555112233		XYZ	Low Value	02.01.2016	03.01.2016	2016	ABC	Title3	B	ijkl	Kim
6	4456111122		ZZZ	Value	03.01.2016	03.01.2016	2016	ABC	Title4	C	wesd	Mary
7	1289111133		MMM	Low Value	03.01.2016	03.01.2016	2016	ABC	Title5	C	ojij	Joe
8	2342667788		ZZZ	Low Value	04.01.2016	04.01.2016	2016	ABC	Title6	A	ojij	Mary
9	4567123456		ZYX	High Value	04.01.2016	04.01.2016	2016	ABC	Title7	A	xcvb	Kim
10	3345567890		XYZ	High Value	05.01.2016	07.01.2016	2016	ABC	Title8	A	eovm	Mary
11	4567223344		MMM	High Value	05.01.2016	08.01.2016	2016	ABC	Title9	A	eovm	John
12	7876445566		NNN	Low Value	05.01.2016	09.01.2016	2016	ABC	Title10	A	ojij	Joe
13	9876112233		OOO	Value	05.01.2016	10.01.2016	2016	ABC	Title11	A	lddd	Kim
14	4498445566		PPP	Value	05.01.2016	11.01.2016	2016	ABC	Title12	A	wesd	Mary
15	5432123456		XYZ	Value	05.01.2016	12.01.2016	2016	ABC	Title13	A	wesd	Joe
16	2903112233		ZZZ	Value	10.01.2016	14.01.2016	2016	ABC	Title14	A	xcvb	John
17	6666445566		ZZZ	Value	10.01.2016	14.01.2016	2016	ABC	Title14	A	xcvb	John
18	7777123456		ZZZ	Value	10.01.2016	14.01.2016	2016	ABC	Title14	A	xcvb	John
19	4567112233		PPP	High Value	11.01.2016	14.01.2016	2016	ABC	Title15	D	eovm	Mary
20	3456781234		PPP	High Value	11.01.2016	14.01.2016	2016	ABC	Title15	D	eovm	Mary
21	2345112233		OOO	High Value	04.02.2016	05.02.2016	2016	DCE	Title16	B	lkjd	Kim

desired result

With Orrin’s code i get the same results.

With snb’s codes I get the same results. Including his latest “Wonder” ( We Wonder how they work ) !

Alan

@ jimbosi
If you check out my code you will see it “captures” the input data using the .CurrentRegion applied to cell A1, - read my comments and you will see that will fail if you have any “isolating” empty column. But as the header is there, that bridges the gap, so the code still works..
_..

I run my code same as before, but with this test data,

Using Excel 2007

Row\Col	A	B	C	D	E	F	G	H	I	J	K	L
1	Serial	Customer	Organization	Appraisal	Author Date	Receipt Date	Year	Customer2	Title	Grade	Eval	Author
2	1234567890		XYZ	Value	01.01.2016	02.01.2016	2016	ABC	Title1	A	ljdd	John
3	4444111122		ZZZ	High Value	01.01.2016	02.01.2016	2016	ABC	Title2	A	lkjd	Joe
4	5432112233, 5555112233		XYZ	Low Value	02.01.2016	03.01.2016	2016	ABC	Title3	B	ijkl	Kim
5	4456111122		ZZZ	Value	03.01.2016	03.01.2016	2016	ABC	Title4	C	wesd	Mary
6	1289111133		MMM	Low Value	03.01.2016	03.01.2016	2016	ABC	Title5	C	ojij	Joe
7	2342667788		ZZZ	Low Value	04.01.2016	04.01.2016	2016	ABC	Title6	A	ojij	Mary
8	4567123456		ZYX	High Value	04.01.2016	04.01.2016	2016	ABC	Title7	A	xcvb	Kim
9	3345567890		XYZ	High Value	05.01.2016	07.01.2016	2016	ABC	Title8	A	eovm	Mary
10	4567223344		MMM	High Value	05.01.2016	08.01.2016	2016	ABC	Title9	A	eovm	John
11	7876445566		NNN	Low Value	05.01.2016	09.01.2016	2016	ABC	Title10	A	ojij	Joe
12	9876112233		OOO	Value	05.01.2016	10.01.2016	2016	ABC	Title11	A	lddd	Kim
13	4498445566		PPP	Value	05.01.2016	11.01.2016	2016	ABC	Title12	A	wesd	Mary
14	5432123456		XYZ	Value	05.01.2016	12.01.2016	2016	ABC	Title13	A	wesd	Joe
15	2903112233, 6666445566, 7777123456		ZZZ	Value	10.01.2016	14.01.2016	2016	ABC	Title14	A	xcvb	John
16	4567112233, 3456781234		PPP	High Value	11.01.2016	14.01.2016	2016	ABC	Title15	D	eovm	Mary
17	2345112233		OOO	High Value	04.02.2016	05.02.2016	2016	DCE	Title16	B	lkjd	Kim

raw data

I get this result as in next post:



EDIT: Appologies Richard - I posted before I refreshed and caught your Post. Sorry.

Hi Jimbosi,

Can you post a sample where my code doesn't "separate out"? The current sample runs just fine with my code.

@ jimbosi
The new code from Post #56 , when working on your test data from Post #51, gives exactly the same results as I showed in Post # 52.
It does the same as all our codes, with one small difference: -
Rather than pasting out to sheet "desired result", it creates a new sheet, and pastes the results out to that.

It is working always on column 1 as the Serial column
All the other codes determine where serial is, so in all the other codes it can be anywhere.
In my code .......
http://www.excelforum.com/showthread...64#post4394064

This line explains how the variable used for the Serial column Number is determined

 cSerial = Application.Match("Serial", arrHeaders(), 0)                 'Application.Match returns the position "along" of the string " Serial"   ,   in the Header Array    ,  stipulating with 0 an exact match

In your new code , that variable is given as
myCol
It is set at ( Hard coded ) to the value 1 . So it always assumes that Serial is in Column 1


_.

You may be running ahead of yourself and tripping over !
I would suggest you get our codes working on the reduced data, then increase your data in steps. It may then be obvious where the problem lies

_.
As I said before, all the codes given to you to date appear to work on all the test data you have so far supplied.
We are all working much too “blind” to see what your problem is.
Maybe one of us will see what the problem is when you give us some more data.

But please note we are here to help. And it is a learning Forum.
This Thread is rich in detailed explanations of how the codes are working.
Usually a code given by us which works on a small representative spread of typical data, will when applied to a much larger sample work just as well. That is normal. Only in ridiculously large data could there start to be limitations.

So
_1) once again, I suggest you convince yourself first that our codes are working on the small sample data you gave. And try to understand at least a little of what is going on
or
_ 2)
Increase your test data a bit, not too much say about 40 lines max, a few more columns if you like. Put ALL the code versions from us that you have tried, ( I assume you have , as you suggested tried them all. Then when you get the errors again post they complete File. One of us will probably see straight away what is wrong.


Then we can take it from there.




Alan

Edit: Please if you get the time check out all the Forum Guidelines and Rules
http://www.excelforum.com/forum-rule...rum-rules.html
You have been a member for a few years now already, ( longer than me !! ). You really should have known about code tags, cross posting etc...

EDIT 2: Going right back to Ppost #29... The file you uploaded and said did not work... I just downloaded it and tried.. it works great,

@ Jimbosi,
Thanks for making the Code tag correction - it is a rich Thread, so it would have been a shame to have had it locked.
_........................

@Orrin.. regarding declaring variables... if one declares all variables appropriately it can help make a start to give the “secret out” of how a code is working!! – Heaven forbid.. Lol..

-........

So to start....

40 Dim c00 As String ' A consecutive string of row numbers with Pipes before. Each Pipe and row number represents a Serial Number in that row. So |2|3|4|4|4 has a single serial number in row 2 and row 3 , but 3 serial numbers in row 4
50 Dim c01 As String ' A consecutive String of Serial column cell values, separated by a comer, effectively a string of all serial numbers
60 Dim SN() As Variant ' Array for input data Range
70 Dim cSerial As Long, j As Long 'column of Serial, row number of input data
80 Dim sp() As String 'This is for an Array of whole Numbers of size equal to the number or serial numbers. Each Number represents the row number of that serial number. Note in this code the Header, "Serial" will be considered as a Serial Number at row 1 ( This is just convenient to get the Headers included in the output)
90 Dim sq() As String 'This is for an Array of all serial numbers ' Note the heading, "Serial", is also considered as a Serial number in this code. ( This is just convenient to get the Headers included in the output)

_.....
___And..
________Then..( code here: http://www.excelforum.com/showthread...t=#post4395059
________________
_________________-____Best to follow that code in Debug F8 mode whilst following my explanations....

100 Put all input data into an Array

130 Determines the column number of Serial

160 – 240 Here those strings c00 and c01 are built up.
_ - we are Going “down” and consider for each input data “row” the cell in the serial column

For c00

180 This bit String(UBound(spX()) + 1, "|") will return | if the cell has one serial number in it and || for 2 serial numbers, ||| for 3 serial numbers etc etc

190 each | is replace by a concatenation of | and the current “row” number.
So you would get something like |3 for “row” 3 if “row” 3 had one serial number in it and |5|5|5 for “row” 5 if “row” 5 had 3 serial numbers in it

210 that last string bit is added to that so far, so you build something of this form as you loop
|1|2|3|4|4|5|5|5 .... etc

230 In the same loop ( so as to be in sequence **** with c00 ) , c01 is built up. It just concatenates together all cells with a comer between. But as the duplicate serial numbers in a cell are also separated by a comer , you end up with a final string of all the serial numbers of this form
,Serial,1234567890,4444111122,5432112233, ... etc. ( Note: for the purposes of the code the heading “Serial” is effectively taken as a serial number – that is just convenient to get that also pasted out finally )

290 300 Just knock off the first unwanted comer or Pipe in the strings

320 330 Changes those strings to Arrays using the comer or Pipe as the separator to split at

340 This bit requires a bit of background reading:

At this point we have all the Info necessary to get our required Output.

We use a “neat” code line technique ( an old friend of mine ) . This is discussed here:
http://www.excelforum.com/excel-new-...ba-arrays.html
http://www.mrexcel.com/forum/excel-q...ml#post4375354

And somewhere here, I think
http://www.snb-vba.eu/VBA_Arrays_en.html

This allows us to pick out the rows and columns that we want from an Input Array and return those into an Output Array.
What we need to in order to use this “neat” code is to have the input Array ( which we have SN() ) and sequential lists of the required row and column Indicies. That is pictorially a bit easier to show

Say my Input Array is this:
Using Excel 2007

Row\Col	A	B	C
1	A1	B1	C1
2	A2	B2	C2
3	A3	B3	C3
4	A4	B4	C4
5	A5	B5	C5
6	A6	B6	C6

BlogOrrin

_...

And I want this output Array
Using Excel 2007

A1	B1	C1
A3	B3	C3
A3	B3	C3
A3	B3	C3
A6	B6	C6

Then to get that output from the input Array, I need the following in my “neat” code line:
I required row indicies
rwsT()={ 1 ; 3 ; 3 ; 3 ; 6 } ( Note a 2 Dimensional 1 column „vertical“ Array )
and column indicies
clms() = { 1 , 2 , 3 } ( Note a 1 Dimensional or 2 Dimensional 1 row „horizontal“ Array
Post #4 http://www.mrexcel.com/forum/general...stops-%94.html
_..............................

So
rwsT()
360 The rows are given by the row indicia list of the string c01, which was converted to the ( almost) required Array format we require , in Array sq() .
I say almost, as in order for the neat technique to work, the row() Array of indices needs to be transposed from a 1 Dimensional “pseudo horizontal” Array to a 2 Dimensional 1 column Array.
So we transpose

clms()
370 The columns Array of indicies required is a simple 1 dimensional Array of the column indicies
1, 2, 3, ... etc.
_ - there are many ways to achieve this.
Now we know the start
= 1
and stop column ( as given for example by the second dimension ( column number ) of our Input Array )
= UBound(SN(), 2)

So it is convenient to use the Spreadsheet Row function such
=Row(1: UBound(SN(), 2))
This gives us 1 ; 2 ; 3 ...... UBound(SN(), 2)
In an Array.
Unfortunately it is a 2 Dimension 1 column Array. So we transpose it to get the 1 dimensional Array we require in the “neat” code line.
( In VBA we may use Excel Spreadsheet Functions within the Evaluate(“_____“) Function )

400 The magic “neat” code line is now used to get our output Array

This Output Array is almost the final that we want. It contains all the original Columns. It has all the rows we need, duplicated where necessary. But the serial column still has the Multi Serial numbers in those duplicated multi serial number rows.

430 To put this Array in the Output Worksheet, we Take the first cell in the Output worksheet and resize it to the size of the Output Array, then assign those Array values to that Spreadsheet Range

470 Finally we replace the serial column ( which still has the duplicated multi serial Number cells in it ) with the Array we made of the serial numbers. This Array was made in the same loop as the row indices, so they line up conveniently.**** ( They are held currently in Array sq() which is a 1 Dimension “pseudo horizontal” Array. But we want to paste out to overwrite the serial column, so we transpose it )

That’s it

Alan