insert & delete new rows automatically

[Felgrand89]

This is a budget sheet I have created:

I want to be able to enter a value into cell "C4" and automatically have a new row inserted, and remove the row when
the cell is empty. I have that working, but when the row is removed, it removes everything in the adjacent columns.
I want it to check adjacent cells in the same row before removing the entire row.

This is the code I am using:


Private Sub Worksheet_Change(ByVal Target As Range)
Dim rCell As Range
Dim rDelete As Range
If Not Intersect(Target, Range("TotalVal").EntireColumn) Is Nothing Then

Application.EnableEvents = False
For Each rCell In Intersect(Target, Range("TotalVal").EntireColumn).Cells

If rCell.Row = Range("TotalVal").Row - 1 Then
If Len(rCell.Value) > 0 Then
Range("TotalVal").EntireRow.Insert
Else
If rDelete Is Nothing Then
Set rDelete = rCell
Else
Set rDelete = Union(rDelete, rCell)
End If
End If
ElseIf Len(rCell.Value) = 0 Then
If rDelete Is Nothing Then
Set rDelete = rCell
Else
Set rDelete = Union(rDelete, rCell)
End If
End If

Next rCell
If Not rDelete Is Nothing Then rDelete.EntireRow.Delete
Application.EnableEvents = True

End If
End Sub