Thank you for your post! I am new to the site- is there a way to acknowledge your help to give you credit, etc.?

I found that the following worked better for my purposes: 



Sub Beautify()
Dim R As Range, Idx As Long

    Set R = Selection
    Idx = 1

    Do While Idx < R.Rows.Count                           ' count dynamically changes as we delete rows
        If R(Idx + 1, 1) = "" Then                        ' found a break line looking 1 down
            R(Idx, 3) = R(Idx, 3) & " , " & R(Idx + 1, 3)   ' append to current
            R(Idx + 1, 1).EntireRow.Delete                ' delete following but do not count up Idx
        Else
            Idx = Idx + 1                                 ' this one is clean, advance
        End If
    Loop
End Sub