Split comma separated entries to new rows [closed]

Question

Closed. This question needs debugging details. It is not currently accepting answers.

Want to improve this question? Update the question so it's on-topic for Stack Overflow.

Closed 6 years ago.

Improve this question

I currently have this data in a sheet

Col A   Col B

1       angry birds, gaming

2       nirvana,rock,band

What I want to do is split the comma separated entries in the second column and insert in new rows like below:

Col A   Col B

1   angry birds

1   gaming

2   nirvana

2   rock

2   band

I am sure this can be done with VBA but couldn't figure it out myself.

JavaScript questions and answers, JavaScript questions pdf, JavaScript question bank, JavaScript questions and answers pdf, mcq on JavaScript pdf, JavaScript questions and solutions, JavaScript mcq Test , Interview JavaScript questions, JavaScript Questions for Interview, JavaScript MCQ (Multiple Choice Questions)

Answer 1

You are better off using variant arrays rather than cell loops - they are much quicker code wise once the data sets are meaningful. Even thoug the code is longer :)

This sample below dumps to column C and D so that you can see the orginal data. Change [c1].Resize(lngCnt, 2).Value2 = Application.Transpose(Y) to [a1].Resize(lngCnt, 2).Value2 = Application.Transpose(Y) to dump over your original data

[Updated with regexp to remove any blanks after , ie ", band" becomes "band"]

Sub SliceNDice()

Dim objRegex As Object

Dim X

Dim Y

Dim lngRow As Long

Dim lngCnt As Long

Dim tempArr() As String

Dim strArr

Set objRegex = CreateObject("vbscript.regexp")

objRegex.Pattern = "^\s+(.+?)$"

 'Define the range to be analysed

X = Range([a1], Cells(Rows.Count, "b").End(xlUp)).Value2

Redim Y(1 To 2, 1 To 1000)

For lngRow = 1 To UBound(X, 1)

     'Split each string by ","

    tempArr = Split(X(lngRow, 2), ",")

    For Each strArr In tempArr

        lngCnt = lngCnt + 1

         'Add another 1000 records to resorted array every 1000 records

        If lngCnt Mod 1000 = 0 Then Redim Preserve Y(1 To 2, 1 To lngCnt + 1000)

        Y(1, lngCnt) = X(lngRow, 1)

        Y(2, lngCnt) = objRegex.Replace(strArr, "$1")

    Next

Next lngRow

 'Dump the re-ordered range to columns C:D

[c1].Resize(lngCnt, 2).Value2 = Application.Transpose(Y)

End Sub