Error 13 when macro run more than once

[parteegolfer]

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

[Tom Ogilvy]

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" <[email protected]>
wrote in message
news:[email protected]...
>
> 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
>

[Jim Cone]

wrng or wrng(2) is not a date.

Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware



"parteegolfer" wrote in message...
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]

This took care of the error message popping up however I have one more issue. I need to have this macro to continue inserting the row "weekly subtotal" if dates are entered into column (A) after the macro was previously run. Can you help with this issue? Currently the macro when run will detect dates in column (A) and insert a row labeled "Weekly Subtotal" after every 5 days. If days are entered after the macro is run nothing happens unless I delete the rows with "weekly Subtotal" previously inserted. then it will insert all the rows as needed.

Hope this makes sense and hopefully you can Help!

[Jim Cone]

Here is a slightly different approach ( I made lots of assumptions).
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware

'-------------------
Sub WeekdayCountRevised()
Dim rngCell As Excel.Range
Dim rngSum As Excel.Range
Dim i As Long
Dim lngR As Long

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

Do
If 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 = 2 To 5
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)
End If
Else
Set rngCell = rngCell(2, 1)
End If
Loop Until Len(rngCell.Value) = 0

End Sub

'--------------------

"parteegolfer" wrote in message ...This took care of the error message popping up however I have one more
issue. I need to have this macro to continue inserting the row "weekly
subtotal" if dates are entered into column (A) after the macro was
previously run. Can you help with this issue? Currently the macro when
run will detect dates in column (A) and insert a row labeled "Weekly
Subtotal" after every 5 days. If days are entered after the macro is
run nothing happens unless I delete the rows with "weekly Subtotal"
previously inserted. then it will insert all the rows as needed.
Hope this makes sense and hopefully you can Help!
--
parteegolfer

[Jim Cone]

Correction:

Change...
Do
If IsDate(rngCell(2, 1)) Then

To...

Do
If IsDate(rngCell) And IsDate(rngCell(2, 1)) Then


Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware

[Jim Cone]

Also, add this line just before the last End If...

"lngR = rngCell.Row"

Jim Cone