I tried to run the the script but once it reached blank cell the macro just stopped.

I also tried input some text on each blank cell but "For loop not initialized" appear.

Please see the code I used down below:

Sub test()

    Dim lastrow As Integer
    Dim i As Integer
    Dim descriptions() As String

    With Worksheets("Sheet1")
        lastrow = .Range("O3").End(xlDown).Row

        For i = lastrow To 3 Step -1
            If InStr(1, .Range("O" & i).Value, ",") \<\> 0 Then
                descriptions = Split(.Range("O" & i).Value, ",")
            End If

            For Each Item In descriptions
                .Range("O" & i).Value = Item
                .Rows(i).Copy
                .Rows(i).Insert
            Next Item

            .Rows(i).EntireRow.Delete
        Next i
    End With
End Sub

Thank you in advanced.

I expected for the script to run through and insert row if cell have commas.

CodePudding user response：

Insert Split Cell Values

• Instead of .Rows(r).Insert, you should consider using .Cells(r, "O").Insert for the rest of the columns not to be affected.
• On the other hand, if you have data in the other columns that need to be copied, in the middle of the inner loop, slip in the line .Rows(r).Copy.

Option Explicit

Sub SplitDescriptions()

    With ThisWorkbook.Sheets("Sheet1")
        
        Dim Descriptions() As String, dUpper As Long, d As Long
        Dim r As Long, rString As String 
        
        For r = .Cells(.Rows.Count, "O").End(xlUp).Row To 3 Step -1
            rString = CStr(.Cells(r, "O").Value)
            If InStr(rString, ",") > 0 Then
                Descriptions = Split(rString, ",")
                dUpper = UBound(Descriptions)
                For d = 0 To dUpper
                    .Cells(r, "O").Value = Descriptions(d)
                    If d < dUpper Then .Rows(r).Insert
                Next d
            End If
         Next r
    
    End With

End Sub

• To get the order left-to-right as top-to-bottom, replace the inner loop with the following.

                For d = dUpper To 0 Step -1
                    .Cells(r, "O").Value = Descriptions(d)
                    If d > 0 Then .Rows(r).Insert
                Next d