Sub Rio_Deployment()

Dim X&, A&, StrX$, ArrX: StrX = Cells(1, 1).Value

For X = 1 To Len(StrX)
     If Mid(StrX, X, 1) = "," Then A = A + 1
Next X

ArrX = Split(StrX, ", ")
For X = 0 To A: Cells(2 + X, 1).Value = ArrX(X): Next X

End Sub

Sub Rio_Deployment2()

Dim X&, A&, StrX$, ArrX: StrX = Cells(1, 1).Value

For X = 1 To Len(StrX)
     If Mid(StrX, X, 1) = "," Then A = A + 1
Next X

ArrX = Split(StrX, ", ")
Rows("2:" & A + 1).Insert

For X = 0 To A
     Cells(1 + X, 1).Value = ArrX(X)
Next X

End Sub

Public Sub Spl()
     Dim x
     x = Split(ActiveCell.Value, ",")
     If Len(ActiveCell.Value) Then
         Rows(ActiveCell.Row).Offset(1, 0).Resize(UBound(x), 1).Insert Shift:=xlShiftDown, CopyOrigin:=xlFormatFromRightOrBelow
         Range(ActiveCell.Address).Resize(UBound(x) + 1, 1).Value = WorksheetFunction.Transpose(x)
     End If
End Sub

Rows(ActiveCell.Row).Offset(1, 0).Resize(UBound(x), 1).Insert Shift:=xlShiftDown, CopyOrigin:=xlFormatFromRightOrBelow

Rows(ActiveCell.Row).Offset(1, 0).Resize(UBound(x)).Insert Shift:=xlShiftDown, CopyOrigin:=xlFormatFromRightOrBelow

Public Sub Spl()
     Dim x, n&, i&
     If Selection.Columns.Count > 1 Then Exit Sub
     n& = Selection.Rows.Count
     For i = n To 1 Step -1
         With Selection(i)
             x = Split(.Value, ",")
             If Len(.Value) And UBound(x) Then
                 Rows(.Row).Offset(1, 0).Resize(UBound(x)).Insert Shift:=xlShiftDown, CopyOrigin:=xlFormatFromRightOrBelow
                 Range(.Address).Resize(UBound(x) + 1, 1).Value = WorksheetFunction.Transpose(x)
             End If
         End With
     Next
End Sub

Sub sdf()
       Dim cell As Range, arr As Variant
       If Selection.Columns.Count > 1 Then Exit Sub
       With Application: .ScreenUpdating = 0: .EnableEvents = 0
           With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
               For Each cell In Selection
                   arr = Split(cell, ", ")
                   If UBound(arr) * Len(cell) Then
                       cell.EntireRow.Offset(1).Resize(UBound(arr)).Insert
                       cell.EntireRow.Copy cell.EntireRow.Offset(1).Resize(UBound(arr))
                       .SetText Replace(Trim(cell), ", ", Chr(10)): .PutInClipboard
                       cell.PasteSpecial xlPasteAll
                   End If
                   Next
           End With
       .ScreenUpdating = 1: .EnableEvents = 1: End With
End Sub

Public Sub Spl()
     Dim x, n&, i&
     If Selection.Columns.Count > 1 Then Exit Sub
     Application.ScreenUpdating = 0
     n& = Selection.Rows.Count
     For i = n To 0 Step -1
         With Selection(i)
             x = Split(.Value, ",")
             If Len(.Value) * UBound(x) Then
                 Rows(.Row).Offset(1, 0).Resize(UBound(x)).Insert Shift:=xlShiftDown, CopyOrigin:=xlFormatFromRightOrBelow
                 .EntireRow.Copy Rows(.Row).Offset(1, 0).Resize(UBound(x))
                 Range(.Address).Resize(UBound(x) + 1, 1).Value = WorksheetFunction.Transpose(x)
             End If
         End With
     Next
     Application.ScreenUpdating = 1
End Sub