Separating lists of data in one cell to multiple rows

[shebe228]

I received a spreadsheet that was submitted from an outside source. I have invoices in one column then the line items of that invoice all in one cell to the right, then the corresponding charges. Is there any way to separate the codes and charges to be in separate cells on multiple rows?


There is no space between the codes to do a find/replace then text to columns. Each invoice has varying number of codes/charges

This is what I have:

Invoice	Code	Charges
79851321987	97110 97140 aa75861	90.00 70.00 8.00
654321884	asdf83476 97082	155.00 2.22
6546513547987	97124 97812 97124 79124 97127 94157 65486 65489	100.00 500.00 50.00 50.00 50.00 50.00 50.00 50.00

<tbody>
</tbody>

This is what I want:

Invoice	Code	Charges
79851321987	97110	90.00
	97140	70.00
	aa75861	8.00
654321884	asdf83476	155.00
	97082	2.22

<tbody>
</tbody>

 

[Fluff]

In an unused cell enter
=CODE(MID(B2,6,1))
change the B2 to point at the cell that contains
97110
97140
aa75861

What does the formula return

 

[shebe228]

It returns "10".

 

[shebe228]

I was able to get the separate the data into multiple columns. Now I need to transpose those columns back to one column. The varying number of columns on each row is what is throwing me off. Suggestions?

My data looks like this:

Invoice	1	2	3	4	5	6	7	8	9
ABC	97110	97140	AAGRT
BCD	99213	AAGRT
CDE	97124	97124	97124	97124	97124	97124	97124	97124	AAGRT

<tbody>
</tbody>

and I want it to look like this

Invoice	Code
ABC	97110
	97140
	AAGRT
BCD	99213
	AAGRT
CDE	97124
	97124
	97124
	97124
	97124
	97124
	97124
	97124
	AAGRT

<tbody>
</tbody>

 

[Fluff]

How about

Sub Splitrws()
   Dim i As Long, x As Long
   
   For i = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
      x = Application.Max(UBound(Split(Cells(i, 2), Chr(10))), UBound(Split(Cells(i, 3), Chr(10))))
      If x > 0 Then
         Rows(i + 1).Resize(x).Insert
         Cells(i, 2).Resize(x + 1).Value = Application.Transpose(Split(Cells(i, 2), Chr(10)))
         Cells(i, 3).Resize(x + 1).Value = Application.Transpose(Split(Cells(i, 3), Chr(10)))
      End If
   Next i
End Sub

Run this on your original data.

 

[shebe228]

How about

Sub Splitrws()
   Dim i As Long, x As Long
   
   For i = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
      x = Application.Max(UBound(Split(Cells(i, 2), Chr(10))), UBound(Split(Cells(i, 3), Chr(10))))
      If x > 0 Then
         Rows(i + 1).Resize(x).Insert
         Cells(i, 2).Resize(x + 1).Value = Application.Transpose(Split(Cells(i, 2), Chr(10)))
         Cells(i, 3).Resize(x + 1).Value = Application.Transpose(Split(Cells(i, 3), Chr(10)))
      End If
   Next i
End Sub

Run this on your original data.

Thanks!! I took the long way around, but it worked. Thank you for your help!!

 

[Fluff]

You're welcome