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/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

[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