Something in this code is causing my workbook to freeze...

[Ironman]

Hi

I am 100% certain that something in the below code is causing my worksheet to hang when I double click on a cell or when I run a macro affecting this sheet - there are NO VBA errors. Unfortunately the code was written for me around 15 years ago, so I can't go back to the author to query it.

I know there is nothing wrong with the functionality of the code because it performs the required function exactly as it should.

Here's the code:

Private Sub Worksheet_Change(ByVal Target As Range)

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

 'This procedure updates the chart for the last 90 days' entries:
    'Call UpdateLast90Days(Target)

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

Sub UpdateLast90Days(Target As Range)
'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

I'm happy to post my workbook to Dropbox if this helps you, although I think the amendment(s) should be fairly straightforward for someone with a good knowledge of writing VBA, which is something I don't have.

I would be IMMENSELY grateful for a solution to this.

Thank you.

 

[jim may]

Step through (line by line - using the F8 key) the code and report back the offending code line.

 

[Jeffrey Mahoney]

Please post the code in the SUB AllFilled

I can't find anything in the code that seems wrong. Does the Chart named Chart9 exist?

 

[Ironman]

Thanks guys.

Private Function AllFilled(Target As Range) As Boolean
AllFilled = False
If Range("A" & Target.Row) <> "" And Range("B" & Target.Row) <> "" And Range("C" & Target.Row) <> "" And _
Range("D" & Target.Row) <> "" And Range("E" & Target.Row) <> "" Then
    AllFilled = True
End If
End Function

Yes, Chart9 exists - it's named "Last 90 Days Runs".

Just to clarify, the hanging occurs when I double click a cell in the same sheet as this code. Double clicking cells in other sheets is OK.

 

[Ironman]

For what it's worth there is a beforedoubleclick event in this sheet as below but I'm almost certain this is not causing the issue.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    ' check Target is in column G
    If Target.Column = 7 Then
        Cancel = True
        TopCell = Cells(12, 3).Address 'Row 12, Column 3 i.e. mileage
        BottomCell = Cells(Target.Row, 3).Address

        TotalCalc = Application.WorksheetFunction.Sum(Range(TopCell, BottomCell))

        MsgBox "Total miles run to " & Format(Cells(ActiveCell.Row, 1), "dd mmmm yyyy: ") & _
                     Format((CLng(10720.31 + TotalCalc)), "#,##0") & "   ", vbOKOnly, "Lifetime Mileage"
    End If

End Sub

Also, I'm sure the code I posted in my first post is to blame because when I commented it out there were no hangs in the sheet at all.

 

[Jeffrey Mahoney]

I got errors, but they were related to not Dimming the variables. Just to be clear, the Worksheet_Change SUB won't run when you double click a cell.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)


  Dim topcell As String
  Dim bottomcell As String
  Dim TotalCalc As Double
  
    ' check Target is in column G
    If Target.Column = 7 Then
        Cancel = True
        topcell = Cells(12, 3).Address 'Row 12, Column 3 i.e. mileage
        bottomcell = Cells(Target.Row, 3).Address


        TotalCalc = Application.WorksheetFunction.Sum(Range(topcell, bottomcell))


        MsgBox "Total miles run to " & Format(Cells(ActiveCell.Row, 1), "dd mmmm yyyy: ") & _
                     Format((CLng(10720.31 + TotalCalc)), "#,##0") & "   ", vbOKOnly, "Lifetime Mileage"
    End If


End Sub

 

[Ironman]

Thanks Jeff.

When I double click any cell in the sheet, the sheet freezes (not hanging, as in waiting for a Sub to end).

I know for a fact the original code I posted is causing the issue because when I comment it out and then double click any cell in the sheet there are no 'freezes' at all, but I don't have the knowledge to understand why or how to amend the code.

 

[Jeffrey Mahoney]

As Jim May stated above, you need to debug the macro and step through one line at a time. Go into the VBA code and while your cursor is on this line:
If Target.Column = 7 Then
Press F9. This toggles a breakpoint. Now when you doubleclick on the sheet the macro will pause on that line of code. Press F8 one line at a time until it either stops working or you get an error. Then let us know what line it stopped on.

Jeff

 

[Ironman]

Thanks Jeff.

I followed your kind instructions and it kept going right to the end, so I guess that wasn't the issue.

However, in the meantime I found I no longer need the code I originally posted because there's some other code that already does the same thing, although I can't locate it.

Thanks a lot for your help and your time Jeff and Jim.

 

[jim may]

Tks for letting us know. Glad you discovered an alternate macro... just hope you can get your hands on it.
Jim