Convert coma delimited cell into rows

[mender]

I have file that was converted into excel spreadsheet from another program. In column B each cell may contain a entry that is comma delimited. I need to convert each cell that has a comma delimited entry to seperate rows under the original cell and to remove the space after the comma.

Example: Before
-------------Column B
Cell 1 Asset Management, Brokerage, Commercial Banking

Example: After
-------------Column B
Cell 1 Asset Management
Cell 2 Brokerage
Cell 3 Commercial Banking

 

[btadams]

This macro assumes there won't be any trailing commas:

Sub CommaSeparatedRows()
Dim strText As String, x As Integer, cell As Range

    Application.ScreenUpdating = False
    ActiveCell.Offset(0, 1).EntireColumn.Insert
    For Each cell In Selection
        strText = cell.Value
        Do While Err = 0
            On Error Resume Next
            x = Application.WorksheetFunction.Find(",", strText)
            If Err = 0 Then
                If Application.CountA(ActiveCell.Offset(0, 1).EntireColumn) = 0 Then
                    cell.Offset(0, 1).Value = Left(strText, x - 1)
                Else
                    cell.Offset(65536 - cell.Row, 1).End(xlUp).Offset(1, 0).Value = Left(strText, x - 1)
                End If
                
                strText = Right(strText, Len(strText) - x)
            Else
                cell.Offset(65536 - cell.Row, 1).End(xlUp).Offset(1, 0).Value = strText
            End If
        Loop
        On Error GoTo 0
    Next cell
    ActiveCell.Offset(0, 1).EntireColumn.AutoFit
    Application.ScreenUpdating = True
End Sub

 

[pgc01]

Hi mender
Welcome to the board

Try this:

Sub SplitCellsRows()
Dim rC As Range, arr, lRow As Long, lLastRow As Long, i As Integer

lLastRow = Range("B" & Rows.Count).End(xlUp).Row

For lRow = lLastRow To 1 Step -1
    Set rC = Range("B" & lRow)
    If rC <> "" Then
        arr = Split(rC, ",")
        rC = Trim(arr(0))
        For i = 1 To UBound(arr)
            rC.Offset(i).EntireRow.Insert (xlShiftDown)
            rC.Offset(i) = Trim(arr(i))
        Next
    End If
Next

End Sub

Hope this helps
PGC