How to solve debug this question in easier way in vba

Question

I have, in column A, a series of different values. Like:

CA_ALAMEDA
CA_ALPINE
OR_LANE

and so on. About 300 rows.

For each row, in column E, I have anywhere from one to 85 values, separated by commas, such as:

SAN LEANDRO,HAYWARD,ALBANY,ALAMEDA
BEAR VALLEY,LAKE ALPINE,KIRKWOOD,MESA VISTA,MARKLEEVILLE,WOODFORDS,FREDRICKSBURG,CRYSTAL SPRINGS
EUGENE,SPRINGFIELD

What I need to do with a macro is

1. Insert a number of rows, between each existing row, equal to the number of commas in the cell in column E. I'm already identifying the number of commas and putting that value in column B. (So the first line shows: CA_ALAMEDA. . . 3. . . <column c=""> . . . <column d=""> . . . SAN LEANDRO,HAYWARD,ALBANY,ALAMEDA

2. Populate the cells in the new rows with the individual values from column E. I'd put those in column C. So, the end result would look like: CA_ALAMEDA . . . 3 . . . SAN LEANDRO . . . <column d=""> . . . SAN LEANDRO,HAYWARD,ALBANY,ALAMEDA . . . . . . . . . . . . . . . . . . HAYWARD . . . . . . . . . . . . . . . . . . ALBANY . . . . . . . . . . . . . . . . . . ALAMEDA CA_ALPINE. . . . . .7 . . . BEAR VALLEY . . . . <column d=""> . . . BEAR VALLEY,LAKE ALPINE,KIRKWOOD,MESA VISTA,MARKLEEVILLE,WOODFORDS,FREDRICKSBURG,CRYSTAL SPRINGS . . . . . . . . . . . . . . . . . . LAKE ALPINE . . . . . . . . . . . . . . . . . . KIRKWOOD CA_ALAMEDA . . . 3 . . . SAN LEANDRO . . . <column d=""> . . . SAN LEANDRO,HAYWARD,ALBANY,ALAMEDA . . . . . . . . . . . . . . . . . . HAYWARD . . . . . . . . . . . . . . . . . . ALBANY . . . . . . . . . . . . . . . . . . ALAMEDA CA_ALPINE. . . . . .7 . . . BEAR VALLEY . . . . <column d=""> . . . BEAR VALLEY,LAKE ALPINE,KIRKWOOD,MESA VISTA,MARKLEEVILLE,WOODFORDS,FREDRICKSBURG,CRYSTAL SPRINGS . . . . . . . . . . . . . . . . . . LAKE ALPINE . . . . . . . . . . . . . . . . . . KIRKWOOD

Answer 1

May try something Like (if i understood the question correctly)

Sub test()
Dim Ws As Worksheet, StrS As Variant, SubNameCnt As Long
Dim Rw As Long
Set Ws = ThisWorkbook.Sheets("Sheet2")
Rw = 1
nm = Ws.Range("A" & Rw).Value
    Do While nm <> ""
    StrS = Split(Ws.Range("E" & Rw).Value, ",")
    SubNameCnt = UBound(StrS) + 1

        'Somehow speedy than single row insert
        If SubNameCnt > 0 Then
        Ws.Range("A" & Rw + 1 & ":A" & Rw + SubNameCnt).EntireRow.Insert xlShiftDown
        Ws.Range("A" & Rw + 1 & ":A" & Rw + SubNameCnt).Value = nm
        Ws.Range("C" & Rw + 1 & ":C" & Rw + SubNameCnt).Value = Application.Transpose(StrS)
        End If

        'A slow process (so not used but produced for simple understanding only)
        'For i = LBound(StrS) To UBound(StrS)
        'Ws.Range("A" & Rw).Offset(i + 1).EntireRow.Insert xlShiftDown
        'Ws.Range("A" & Rw).Offset(i + 1).Value = nm
        'Ws.Range("A" & Rw).Offset(i + 1, 1).Value = i + 1
        'Ws.Range("A" & Rw).Offset(i + 1, 2).Value = StrS(i)
        'Next i

    Rw = Rw + SubNameCnt + 1
    nm = Ws.Range("A" & Rw).Value
    Loop
End Sub

Code tested with makeshift data