CODEWITHSUNDEEP
excelvba
user8454796
user8454796

Reputation:

Transform comma separated cells into multiple rows by label value (Excel VBA)

Column A contains the labels or outcome value, Columns B-N contain varying lengths of comma separated values, but range for each column is the same (i.e., 1-64). The goal is to covert to a new table with Column A representing the value range (1-64) and Columns B-N the labels/outcome from the original table.

Example

A semi-related solution was sought here, but without use of macros.

Upvotes: 0

Views: 533

Answers (2)

Dy.Lee
Dy.Lee

Reputation: 7567

Try this code.

Sub test()
    Dim vDB, vR()
    Dim vSplit, v As Variant
    Dim Ws As Worksheet
    Dim i As Long, n As Long, j As Integer, c As Integer

    vDB = Range("a2").CurrentRegion
    n = UBound(vDB, 1)
    c = UBound(vDB, 2)

    ReDim vR(1 To 64, 1 To c)
    For i = 1 To 64
        vR(i, 1) = i
    Next i


    For i = 2 To n
        For j = 2 To c
            vSplit = Split(vDB(i, j), ",")
                For Each v In vSplit
                    vR(v, j) = vDB(i, 1)
                Next v
        Next j
    Next i
    Set Ws = Sheets.Add '<~~ replace your sheet : Sheets(2)
    With Ws
        For i = 1 To c
            .Range("b1")(1, i) = "COND" & i
        Next i
        .Range("a2").Resize(64, c) = vR
    End With
End Sub

Upvotes: 0

Gowtham Shiva
Gowtham Shiva

Reputation: 3875

I will let you to modify this code,

Sub splitThem()
Dim i As Long, j As Long, k As Long, x As Long
x = 1
Sheets.Add.Name = "newsheet"
For j = 2 To Cells(1, Columns.Count).End(xlToLeft).Column
For i = 1 To Cells(Rows.Count, 2).End(xlUp).Row
If Cells(i, j) <> "" Then
    For k = 1 To Len(Cells(i, j)) - Len(Replace(Cells(i, j), ",", "")) + 1
        Sheets("newsheet").Cells(x, j) = Cells(i, 1)
        x = x + 1
    Next k
End If
Next i
x = 1
Next j
End Sub

enter image description here

Upvotes: 1

Related Questions