Basic error in my code that I'm unable to identify

Ironman

Well-known Member
Joined
Jan 31, 2004
Messages
1,069
Office Version
  1. 365
Platform
  1. Windows
Hi

There's something in my below code that causes the workbook to hang either during or immediately after the named procedures run and I strongly suspect the cause is either in the first or last 4 rows.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)

CALC = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False

 'Messages are contained here:
    Call ImportantMessages
 'This procedure updates the graph for the last 90 days' entries:
    Call UpdateLast90Days(Target)
 'This procedure copies validation from the first found entry:
    'Call CopyValidation(Target)

Application.Calculation = CALC
Application.Calculate
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Also, the sheet has fairly recently been made protected (without a password) and I'm unsure whether a line is required to unprotect it.

I'd be really grateful for a solution.

Thank you!
 
Last edited:

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN
could you put the code of the following

Call ImportantMessages
Call UpdateLast90Days(Target)
 
Upvote 0
Hi Jeff, thanks for replying.

Yes, they all do. I'm very inexperienced in VBA and trying to logic my way to a solution and thought if I only recently protected the worksheet then it might be the cause.
 
Upvote 0
could you put the code of the following

Call ImportantMessages
Call UpdateLast90Days(Target)

Hi Dante, great to hear from you again, thanks for replying!

Call ImportantMessages contains a number of simple macros almost identical to the below:
Code:
If Range("VBA_YTD_DAYS") = 183 Then
If [F1] = "" Then
MsgBox "Congratulations!" & vbNewLine & vbNewLine & "You've just reached the bronze standard   " & vbNewLine _
& "you've exercised five times a week on average this year", vbInformation, "Year to Date Mileage"
[F1] = "1"
End If
End If
End Sub

Call UpdateLast90Days (Target):
Code:
Sub UpdateLast90Days(Target As Range)
'**************************************************************
'*******This procedure is called in Sub WorksheetChange********
'**************************************************************
'This updates the Last 90 Runs chart:

Dim X1 As Range
Dim Tmp()
If Target.Cells.Count > 1 Then GoTo en
LastEntry = Range("A20000").End(xlUp).Row
Set ISECT = Application.Intersect(Target, Range("A" & LastEntry - 90 & ":E" & LastEntry))
Set ISECT1 = Application.Intersect(Target, Range("A12:E" & LastEntry))
If Not (ISECT Is Nothing) And Not (ISECT1 Is Nothing) Then
    If AllFilled(Target) Then
        Ans = MsgBox("Route:   " & (Range("B" & Target.Row) & Chr(13) & Chr(13) & _
        "Date:     " & Format(Range("A" & Target.Row), "dddd dd mmmm yyyy") & Chr(13) _
        & "Miles:     " & Range("C" & Target.Row) & Chr(13) _
        & "Pace:     " & Range("E" & Target.Row).Text & " min/mile " & Chr(13) & Chr(13) & _
        "Update Last 90 Days Running Chart now?"), vbOKCancel + vbQuestion, "New Training Log Entry")
        If Ans = vbCancel Then
            MsgBox "Last 90 Days Running Chart NOT updated", vbExclamation, "Last 90 Days Running Chart Update"
            GoTo en
        End If
    Else: GoTo en
    End If
    
        Last = Worksheets("Training Log").Range("A20000").End(xlUp).Row + 1
        FIRST = Last - 90
        Set X1 = Worksheets("Training Log").Range("A" & FIRST & ":A" & Last)
            Tmp = X1.Value
            Worksheets("90R Data").Range("A2:A91") = Tmp
        Set X1 = Worksheets("Training Log").Range("C" & FIRST & ":C" & Last)
            Tmp = X1.Value
            Worksheets("90R Data").Range("B2:B91") = Tmp
        Set X1 = Worksheets("Training Log").Range("E" & FIRST & ":E" & Last)
            Tmp = X1.Value
            Worksheets("90R Data").Range("C2:C91") = Tmp
            For Each c In Worksheets("90R Data").Range("C2:C91")
                c.Value = c.Value * 24 * 60
            Next c
        Application.Calculate
        Chart9.SeriesCollection(1).Values = Worksheets("90R Data").Range("H2:H91")
        Chart9.SeriesCollection(2).Values = Worksheets("90R Data").Range("I2:I91")
        MsgBox "Last 90 Days Running Chart updated successfully", vbInformation, "Last 90 Days Running Chart Update"
            
ElseIf Not (ISECT1 Is Nothing) Then
Dim LatestEntry As String
LatestEntry = Range("A" & LastEntry).Value

MsgBox "The entry you tried to edit is more than 90 days" & vbNewLine & "from the most recent entry (" & LatestEntry & ")" & _
"    " & Chr(13) & Chr(13) & _
    "Last 90 Days Running Chart NOT updated", vbInformation, "Data Beyond Last 90 Days"
End If
en:

DoEvents

End Sub

The above 2 subs have always run OK in the past, which is what makes me think the rows I highlighted in my first post are the cause but I don't know enough to understand what those 4 rows actually do (both subs were kindly written for me some years ago).

Thanks again!
 
Upvote 0
Hi, I have not moved from here

CALC = Application.Calculation, stores the current state of Calculation
Application.Calculation = xlCalculationManual, Change the calculation to manual
Application.ScreenUpdating = False, turn off the screen update
Application.EnableEvents = False, turn off the events on the sheet, this avoids entering a loop

But those lines do not stop the process, on the contrary, they are to do it faster.

Run the macro step by step with F8 so you can see when the macro hangs up.
 
Upvote 0
OK Dante, I'll do that and come back to you.

Thanks again!
 
Upvote 0
Unprotect the sheet and run it again. No error and there's your problem. I agree with Dante, Debug one step at a time.
 
Upvote 0
Hi guys, I've just spent the last 3 hours or so trying to resolve this and I finally identified the cause of the hanging to be unrelated to the above - it was the Call CopyValidation(Target) code, which hadn't been entirely commented out.

Many thanks for your help Jeff and Dante.
 
Upvote 0

Forum statistics

Threads
1,223,888
Messages
6,175,217
Members
452,619
Latest member
Shiv1198

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top