Try this - I think it should do what you want.
Option Explicit
Public Sub ExpandList()
Dim r As Long, x As Long, StartRow As Long
Dim Fruits As Variant
r = 1
Do While Cells(r, 1).Value <> ""
If InStr(Cells(r, 4).Value, ",") <> 0 Then
StartRow = r
Fruits = Split(Cells(r, 4).Value, ",")
For x = 0 To UBound(Fruits) Step 1
Rows(r + 1).Insert
Cells(r + 1, 1).Value = Cells(r, 1).Value
Cells(r + 1, 2).Value = Cells(r, 2).Value
Cells(r + 1, 3).Value = Cells(r, 3).Value
Cells(r + 1, 4).Value = Trim(Fruits(x))
r = r + 1
Next
Rows(StartRow).Delete
Else
r = r + 1
End If
Loop
End Sub
Bookmarks