Insert multiple rows when range contains specific text-CodePudding

I am trying to have a macro to run through a column of data and insert a row for every instance it counts a "," so for example it would insert another 3 rows above Joanne

I currently have this code below but it doesn't work and im not sure im on the right track for it as I think it is looking for "," to only be the only contents in the cell? Any help/guidance would be greatly appreciated.

Sub InsertRow()
Dim cell As Range
For Each cell In Range("E2:E9999")
    If cell.Value = "," Then
        cell.EntireRow.Insert
    End If
Next cell
End Sub

CodePudding user response：

Insert As Many Rows As There Are Commas

Option Explicit

Sub InsertCommaRows()
    
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    Dim lRow As Long: lRow = ws.Cells(ws.Rows.Count, "E").End(xlUp).Row
    
    Application.ScreenUpdating = False
    
    Dim cString As String
    Dim CommasCount As Long
    Dim r As Long
    
    For r = lRow - 1 To 2 Step -1
        Debug.Print ws.Cells(r, "E").Address(0, 0)
        cString = CStr(ws.Cells(r, "E").Value)
        CommasCount = Len(cString) - Len(Replace(cString, ",", ""))
        If CommasCount > 0 Then
            ws.Cells(r   1, "E").Resize(CommasCount).EntireRow _
                .Insert xlShiftDown, xlFormatFromLeftOrAbove
        End If
    Next r

    Application.ScreenUpdating = True

    MsgBox "Comma-rows inserted.", vbInformation

End Sub

CodePudding user response：

This code counts the commas then inserts the same number of rows immediately below the current cell.

Sub InsertRow()
Dim cell As Range
Dim iCommas As Integer
For Each cell In ActiveSheet.Range("E2:E9999")
    iCommas = Len(cell.Value) - Len(Replace(cell.Value, ",", ""))
    If iCommas > 0 Then
        cell.Offset(1).Resize(iCommas).EntireRow.Insert xlDown
    End If
Next cell
End Sub