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

Ironman

Well-known Member
Joined
Jan 31, 2004
Messages
1,069
Office Version
  1. 365
Platform
  1. Windows
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:
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.
 
Last edited:

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
Step through (line by line - using the F8 key) the code and report back the offending code line.
 
Upvote 0
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?
 
Upvote 0
Thanks guys.

Code:
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.
 
Last edited:
Upvote 0
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.
Code:
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.
 
Last edited:
Upvote 0
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.

Code:
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
 
Upvote 0
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.
 
Last edited:
Upvote 0
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
 
Upvote 0
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.
 
Last edited:
Upvote 0
Tks for letting us know. Glad you discovered an alternate macro... just hope you can get your hands on it.
Jim
 
Upvote 0

Forum statistics

Threads
1,213,491
Messages
6,113,963
Members
448,536
Latest member
CantExcel123

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