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"

--
Regards,
Tom Ogilvy

"parteegolfer" wrote:

>
> 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
>
>
> --
> parteegolfer
> ------------------------------------------------------------------------
> parteegolfer's Profile: http://www.excelforum.com/member.php...o&userid=31951
> View this thread: http://www.excelforum.com/showthread...hreadid=522250
>
>