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

I have this seen solution http://www.excelfox.com/forum/f22/re...ata-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

Try this

Code:

---

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

---

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

Code:

---

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

---

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.

Code:

---

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

---