Rearrange A Delimited Column Of Data In To Separate Rows With Fixed Number Of Columns

[digitalcaptive]

I have this seen solution http://www.excelfox.com/forum/f22/redistribute-a-delimited-column-of-data-into-separate-rows-keeping-other-data-as-is-420/ but it puts everything in one column.

I want to split the delimited column into a fixed number of columns, specifically two.

Example Input:

Column A | Column B
1 | A, B, C, D, E
2 | F, G, H, I, K, L, M, N, O
3 | P, Q, R, S

Example Output:

Column A | Column B | Column C
1 | A | B
1 | C | D
1 | E
2 | F | G
2 | H | I
2 | K | L
2 | M | N
2 | O
3 | P | Q
3 | R | S

[Excel Fox]

Try this


Sub Consolidator()

Dim var As Variant, varOut As Variant
Dim lng As Long
Dim lngRows As Long
Dim lngIndex As Long
Dim lngSplit As Long
var = Range("A1").CurrentRegion.Resize(, 2).Value2
For lngRows = LBound(var) To UBound(var)
lng = lng + CLng((UBound(Split(var(lngRows, UBound(var, 2)), ",")) + 2) / 2)
Next lngRows
ReDim varOut(1 To lng, 1 To 2)
lngIndex = 1
For lngRows = LBound(var) To UBound(var)
lng = CLng((UBound(Split(var(lngRows, UBound(var, 2)), ",")) + 2) / 2)
For lng = lngIndex To lngIndex + lng - 1
lngSplit = lngSplit + 1
varOut(lng, 1) = var(lngRows, UBound(var, 2) - 1)
varOut(lng, 2) = Split(var(lngRows, UBound(var, 2)) & ",", ",")(lngSplit * 2 - 2) & "," & Split(var(lngRows, UBound(var, 2)) & ",", ",")(lngSplit * 2 - 1)
Next lng
lngIndex = lng
lngSplit = 0
Next lngRows
ActiveSheet.Next.Cells(1).Resize(UBound(varOut), 2).Value = varOut

End Sub

[Excel Fox]

Just realized that you wanted the output in separate columns. The above keeps the output in a single column. The below splits it in to two columns



Sub Consolidator()

Dim var As Variant, varOut As Variant
Dim lng As Long
Dim lngRows As Long
Dim lngIndex As Long
Dim lngSplit As Long
var = Range("A1").CurrentRegion.Resize(, 2).Value2
For lngRows = LBound(var) To UBound(var)
lng = lng + CLng((UBound(Split(var(lngRows, UBound(var, 2)), ",")) + 2) / 2)
Next lngRows
ReDim varOut(1 To lng, 1 To 3)
lngIndex = 1
For lngRows = LBound(var) To UBound(var)
lng = CLng((UBound(Split(var(lngRows, UBound(var, 2)), ",")) + 2) / 2)
For lng = lngIndex To lngIndex + lng - 1
lngSplit = lngSplit + 1
varOut(lng, 1) = var(lngRows, UBound(var, 2) - 1)
varOut(lng, 2) = Split(var(lngRows, UBound(var, 2)) & ",", ",")(lngSplit * 2 - 2)
varOut(lng, 3) = Split(var(lngRows, UBound(var, 2)) & ",", ",")(lngSplit * 2 - 1)
Next lng
lngIndex = lng
lngSplit = 0
Next lngRows
ActiveSheet.Next.Cells(1).Resize(UBound(varOut), 3).Value = varOut

End Sub

[Excel Fox]

Well actually, I thought the first column contains index numbers, 1,2,3 etc. But it seems that was just you showing that the data started from Row 1

So you can use the following lines of code instead of the ones above.


Sub Consolidator()

Dim var As Variant, varOut As Variant
Dim lng As Long
Dim lngRows As Long
Dim lngIndex As Long
Dim lngSplit As Long
var = Range("A1").CurrentRegion.Resize(, 1).Value2
For lngRows = LBound(var) To UBound(var)
lng = lng + CLng((UBound(Split(var(lngRows, UBound(var, 2)), ",")) + 2) / 2)
Next lngRows
ReDim varOut(1 To lng, 1 To 2)
lngIndex = 1
For lngRows = LBound(var) To UBound(var)
lng = CLng((UBound(Split(var(lngRows, UBound(var, 2)), ",")) + 2) / 2)
For lng = lngIndex To lngIndex + lng - 1
lngSplit = lngSplit + 1
varOut(lng, 1) = Split(var(lngRows, UBound(var, 2)) & ",", ",")(lngSplit * 2 - 2)
varOut(lng, 2) = Split(var(lngRows, UBound(var, 2)) & ",", ",")(lngSplit * 2 - 1)
Next lng
lngIndex = lng
lngSplit = 0
Next lngRows
ActiveSheet.Next.Cells(1).Resize(UBound(varOut), 2).Value = varOut

End Sub