Friday, November 15, 2013

Split comma separated entries to new rows in Excel

How to convert the below data in a Excel 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
This can be done with VBA. There is excellent solution provided on stackoverflow here

brettdj's code was very helpful! The extended code by Kolath to add a user input to select the range to transform, the target column, and the delimeter. He set this up tied to a keyboard macro so that it could do this to a bunch of different columns. Code credit goes to both of them.


Below is the Macro to be used
Sub SliceNDice()
Dim objRegex
Dim inputRange
Dim outputRange
Dim lngRow As Long
Dim lngCnt As Long
Dim tempArr() As String
Dim strArr
Dim outputCell
Dim delimeter As String
Set objRegex = CreateObject("vbscript.regexp")
objRegex.Pattern = "^\s+(.+?)"

'Get input range from the user
Set inputRange = Application.InputBox(Prompt:="Please Select Range", Title:="Range Select", Type:=8)
Set outputCell = Application.InputBox(Prompt:="Please Select output range", Title:="Output Select", Type:=8)
delimeter = Application.InputBox(Prompt:="Please Select delimeter", Title:="Delimeter Select")

'Define the range to be analysed
inputRange = Range([a1], Cells(Rows.Count, "b").End(xlUp)).Value2
ReDim outputRange(1 To 2, 1 To 1000)
For lngRow = 1 To UBound(inputRange, 1)

'Split each string by ","
tempArr = Split(inputRange(lngRow, 2), delimeter)
For Each strArr In tempArr lngCnt
    lngCnt = lngCnt + 1

    'Add another 1000 records to resorted array every 1000 records
    If lngCnt Mod 1000 = 0 Then ReDim Preserve outputRange(1 To 2, 1 To lngCnt + 1000)
    
    outputRange(1, lngCnt) = inputRange(lngRow, 1)
    outputRange(2, lngCnt) = objRegex.Replace(strArr, "$1")
Next
Next lngRow

'Dump the re-ordered range to target columns
outputCell.Resize(lngCnt, 2).Value2 = Application.Transpose(outputRange)
 End Sub

Be sure to have the data in the same format as provided in sample. Also while selecting the input range select the first set of row and in output range only the first set of columns. This will also add header row by default.







No comments:

Post a Comment