Whatever is in wrng or wrng(2) is not a valid argument to the Weekday
function. Assume if this happens, you want to terminate processing.


Sub weekdaycount()
Dim wrng As Range, lrng As Range
Dim count As Long

On Error goto ErrHandler

Set wrng = Cells(8, "a") '<<=== start range - change if need
Set lrng = Cells(Cells.Rows.count, "a").End(xlUp)
Do While (wrng.Row <= lrng.Row)
count = 1
Do While (Weekday(wrng) <= Weekday(wrng(2))
If wrng(2) < "" Then
Set wrng = wrng(2)
count = count + 1
Else
Exit Do
End If
Loop
Set wrng = wrng(2)
wrng.EntireRow.Insert
wrng(0) = "Weekly Subtotal"
Loop
Dim rng As Range
Dim lastrow As Long, r As Long, i As Integer
With ActiveSheet
lastrow = .Cells(Rows.count, "A").End(xlUp).Row
r = 1
srow = r
Do
Do
r = r + 1
Loop Until .Cells(r, "a") = "Weekly Subtotal" Or r = lastrow
For i = 4 To 7
Set rng = .Range(.Cells(srow, i), .Cells(r - 1, i))
Cells(r, i) = Application.Sum(rng)
Next i
srow = r + 1
Loop Until srow lastrow
End With
ErrHandler:

End Sub






--
Regards,
Tom Ogilvy

"parteegolfer"
wrote in message
news:parteegolfer.24kqoz_1142196302.5418@excelforu m-nospam.com...

I have an issue when this macro is run more than one I get error 13. at
the spot indicated in the VBA below. I don't know how to eleiminate it
or ignore if the macro is run multiple times.

Can anyone help!

Sub weekdaycount()
Dim wrng As Range, lrng As Range
Dim count As Long

Set wrng = Cells(8, "a") '<<=== start range - change if need
Set lrng = Cells(Cells.Rows.count, "a").End(xlUp)
Do While (wrng.Row <= lrng.Row)
count = 1
Do While (Weekday(wrng) <= Weekday(wrng(2)))<<Error 13 Here
If wrng(2) < "" Then
Set wrng = wrng(2)
count = count + 1
Else
Exit Do
End If
Loop
Set wrng = wrng(2)
wrng.EntireRow.Insert
wrng(0) = "Weekly Subtotal"
Loop
Dim rng As Range
Dim lastrow As Long, r As Long, i As Integer
With ActiveSheet
lastrow = .Cells(Rows.count, "A").End(xlUp).Row
r = 1
srow = r
Do
Do
r = r + 1
Loop Until .Cells(r, "a") = "Weekly Subtotal" Or r = lastrow
For i = 4 To 7
Set rng = .Range(.Cells(srow, i), .Cells(r - 1, i))
Cells(r, i) = Application.Sum(rng)
Next i
srow = r + 1
Loop Until srow lastrow
End With

End Sub


--
parteegolfer
------------------------------------------------------------------------
parteegolfer's Profile:
http://www.excelforum.com/member.php...o&userid=31951
View this thread: http://www.excelforum.com/showthread...hreadid=521539