Need help with Macro

[parteegolfer]

I have this code that detects dates in Column (A). At the end of the
workweek when the macro runs it inserts a row with "Weekly Totals" and
sums up certain columns.

The problem I have is if there is no date after a weeks end it will not
insert a row with "Weekly Subtotal".

Below is the code.........PLEASE HELP!

Sub WeeklySubtotal()
Dim rngCell As Excel.Range
Dim rngSum As Excel.Range
Dim i As Long
Dim lngR As Long

Set rngCell = Range("A9")
lngR = rngCell.Row

Do
If IsDate(rngCell) And IsDate(rngCell(2, 1)) Then
If Weekday(rngCell(2, 1).Value) < Weekday(rngCell.Value) Then
rngCell(2, 1).EntireRow.Insert
rngCell(2, 1).Value = "Weekly Subtotal"

For i = 4 To 7
Set rngSum = Range(rngCell(1, i), Cells(lngR, i))
rngCell(2, i).Value = Application.Sum(rngSum)
Next i

Set rngCell = rngCell(3, 1)
lngR = rngCell.Row
Else
Set rngCell = rngCell(2, 1)
lngR = rngCell.Row
End If
Else
Set rngCell = rngCell(2, 1)
lngR = rngCell.Row
End If
Loop Until Len(rngCell.Value) = 0

End Sub

 

[Tom Ogilvy]

Dim bAdd as Boolean

bAdd = False
If IsDate(rngCell) and ( IsDate(rngCell(2, 1)) or isempty(rngCell(2,1))) Then
if not isempty(rngCell(2,1)) then
bAdd = _
Weekday(rngCell(2, 1).Value) < Weekday(rngCell.Value)
else
bAdd = True
end if
If bAdd Then
rngCell(2, 1).EntireRow.Insert
rngCell(2, 1).Value = "Weekly Subtotal"