Allow users to intercept when code is running

tiredofit

Well-known Member
Joined
Apr 11, 2013
Messages
1,394
One way to to allow users to intercept code when it's running is to use DoEvents.

The problem I have is despite having added DoEvents, my program crashes. I do have a working version and will explain later.

Firstly in wksData, I have 5 columns of data. Column A contains date, columns B through to E contains the data. In order to follow the code, cell A2 should contain the date 4/1/1984. Then A3 should be 5/1/1984, etc.

Columns B to E can contain any values.

Ensure you have data from row 2 down to 10000 just to give the code time to run.

Add three Range Names:

DataStart
Interval
Start

Makes sure these refer to some blank cells on the worksheet, eg M1, N1 and O1.

Then create a line chart manually based on the data.

Here's the code:

This is in wksData, ie the worksheet:

Code:
Option Explicit

    Dim OrigVal As Variant
  
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
      
    Target(1, 1).Select

    OrigVal = Target(1, 1).Value
  
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
  
    Call ModReverse.Reverse(Rng:=Target, _
                            OrigVal:=OrigVal)
                          
End Sub

This is in a module called FnLastRow:

Code:
Option Explicit

Public Function LRowInCol(ByRef wks As Variant, _
                          ByRef Col As Variant) As Long

    On Error GoTo Correction

        If TypeName(wks) = "String" Then Set wks = Worksheets(wks)

        LRowInCol = wks.Columns(Col).Find(What:="*", _
                                          LookIn:=xlFormulas, _
                                          SearchOrder:=xlRows, _
                                          SearchDirection:=xlPrevious, _
                                          SearchFormat:=False).Row
                                        
ExitPoint:
  
    On Error GoTo 0
  
    Exit Function

Correction:

        LRowInCol = 1
  
    Resume ExitPoint
  
End Function

This is in ModChartUpdate:

Code:
Option Explicit

Public Sub ChartUpdate()

    Dim UpdateChart As ClsChartUpdate
    Set UpdateChart = New ClsChartUpdate

    Call UpdateChart.ChartUpdate

    Set UpdateChart = Nothing
  
End Sub

ModReverse:

Code:
Option Explicit

Public Sub Reverse(ByRef Rng As Range, _
                   ByRef OrigVal As Variant)

    Dim MyReverse As ClsReverse
    Set MyReverse = New ClsReverse
                  
    With MyReverse

        Set .Rng = Rng
        .OrigVal = OrigVal

        Call .Reverse
  
    End With

    Set MyReverse = Nothing
  
End Sub

This is in a class module, called ClsChartUpdate :

Code:
Option Explicit

    Private ChartSettings As ClsSettings
  
Private Sub Class_Initialize()

    Set ChartSettings = New ClsSettings
  
    With ChartSettings
      
        .Interval = wksData.Range("Interval").Value
        .DataStart = wksData.Range("DataStart").Value
  
    End With
  
End Sub

Private Sub Class_Terminate()

    Set ChartSettings = Nothing
  
End Sub

Public Sub ChartUpdate()
  
    Dim LastRowwksData As Long
  
    LastRowwksData = FnLastRow.LRowInCol(wks:=wksData, _
                                         Col:=1)
  
    Dim DataRng As Range
  
    With wksData
  
        Set DataRng = .Range(.Cells(2, 1), .Cells(LastRowwksData, 1))
  
    End With
  
    Do Until Not IsError(Application.Match(ChartSettings.DataStart, DataRng, 0))
  
        ChartSettings.DataStart = ChartSettings.DataStart + 1
  
    Loop

    Start = ChartSettings.DataStart
      
    Dim RowNumber As Long
  
    RowNumber = Application.Match(ChartSettings.DataStart, DataRng, 0)
 
    Set DataRng = Nothing
  
    Dim Cht As Chart
    Set Cht = wksData.ChartObjects("Chart 1").Chart
  
    Dim Counter As Integer
  
    With wksData
  
        Cht.FullSeriesCollection(1).XValues = Range(.Cells(RowNumber + 1, 1), .Cells(RowNumber + ChartSettings.Interval, 1))
      
        On Error Resume Next
      
           For Counter = 2 To 5
         
              Cht.FullSeriesCollection(Counter - 1).Values = Range(.Cells(RowNumber + 1, Counter), .Cells(RowNumber + ChartSettings.Interval, Counter))
      
           Next Counter
      
    End With
  
    Set Cht = Nothing
  
End Sub


This is in a class module, called ClsReverse:

Code:
Option Explicit

    Private pRng As Range
    Private pOrigVal As Variant
  
Public Property Get Rng() As Range

    Set Rng = pRng
  
End Property

Public Property Set Rng(ByVal R As Range)

    Set pRng = R
  
End Property

Public Property Get OrigVal() As Variant

    OrigVal = pOrigVal
  
End Property

Public Property Let OrigVal(ByVal OVal As Variant)

    pOrigVal = OVal
  
End Property

Public Sub Reverse()

    Application.EnableEvents = False
  
    With Me
         
        .Rng(1).Value = .OrigVal
  
    End With
  
    Application.EnableEvents = True
       
End Sub

This is in a class module, ClsSettings:

Code:
Option Explicit

    Private pInterval As Long
    Private pDataStart As Long

Public Property Get Interval() As Long

    Interval = pInterval

End Property

Public Property Let Interval(ByVal I As Long)

    pInterval = I

End Property

Public Property Get DataStart() As Long

    DataStart = pDataStart

End Property

Public Property Let DataStart(ByVal DStart As Long)

    pDataStart = DStart

End Property


This is the main code, in a standard module called ModTest:

Code:
Option Explicit

    Public Start As Long
    Public Initial As ClsSettings
    Public DateStart As ClsSettings
  
Public Sub Test()
  
    Dim Cht As ChartObject
  
    Start = 30685
  
    '*****
  
    ' Added so clicking on cells does not stop chart updating.
  
    On Error Resume Next

    '*****
  
 
        Do Until Start = 44124
                           
            Set Cht = wksData.ChartObjects("Chart 1")
  
            Cht.Activate
          
            Set Cht = Nothing
  
            With Application
          
                .EnableEvents = False
          
                wksData.Range("DataStart").Value = Start
              
                ActiveCell.Activate
              
                Call ModChartUpdate.ChartUpdate
              
                .EnableEvents = True
          
            End With
          
            DoEvents
           
            Start = Start + 1
          
        Loop
      
    On Error GoTo 0
  
End Sub


The problem is when I run Test, the chart updates as expected.

However whilst it's running, when I click on a cell on the worksheet and attempt to change its value, the program hangs.

I have added both On Error Resume Next and DoEvents, so didn't expect it to crash.

As explained, I have a workaround but it's convoluted. It a involves adding a Spin Button and these two line of code:

Code:
ActiveCell.Activate
               
Call ModChartUpdate.ChartUpdate

are associated with the Spin Button.

Why it needs to go about in this way, I have no idea.

Any help greatly appreciated.

Thanks
 
Last edited:

Some videos you may like

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.

GWteB

Well-known Member
Joined
Sep 10, 2010
Messages
1,295
Office Version
  1. 2013
Platform
  1. Windows
Haven't tried your code (and I'm not going to either ...) but a quick look at your code tells me that recursion occurs.
I'm affraid you have to suppress the occurrence of some events or have to choose a different approach. A change of the contents of a cell generates such an event, namely the Worksheet_Change event. Nothing wrong with that, but you're capturing that event with your code and are using the occurence of that event to generate more change events, which eventually crashes things very quickly, unless you take appropriate measures.
 

tiredofit

Well-known Member
Joined
Apr 11, 2013
Messages
1,394
Haven't tried your code (and I'm not going to either ...) but a quick look at your code tells me that recursion occurs.
I'm affraid you have to suppress the occurrence of some events or have to choose a different approach. A change of the contents of a cell generates such an event, namely the Worksheet_Change event. Nothing wrong with that, but you're capturing that event with your code and are using the occurence of that event to generate more change events, which eventually crashes things very quickly, unless you take appropriate measures.
Thanks for your info.

As I said, I do have a workaround but don't understand why it works.

The "working" version goes as follows:

Without delving into the code, when the program runs, the cell which is linked to the Spin Button is changed, which triggers the Spin Button click event.

In the Spin Button click event, it contains these two lines of code:

Code:
ActiveCell.Activate
               
Call ModChartUpdate.ChartUpdate

and the chart gets updated.

Essentially the "working" version is doing this:

Code:
Call Sub A

but all Sub A does is it calls Sub B

and all Sub B does is it calls Sub C

so I thought why not just write:

Code:
Call Sub C

Because the Spin Button click event resides in wksData, like:

Code:
Private Sub SpinButton1_Change()
    
    ActiveCell.Activate
  
    Call ModControls.SpinButtonMove
    
End Sub

I even tried adding this in wksData:

Code:
Public Sub Workaround()
    
    ActiveCell.Activate
  
    Call ModControls.SpinButtonMove
    
End Sub

then in Test, refer to it:

Code:
Call wksData.Workaround

but it still failed.
 

tiredofit

Well-known Member
Joined
Apr 11, 2013
Messages
1,394
I have done some research and have found this is the code at fault:

Code:
Do Until Not IsError(Application.Match(ChartSettings.DataStart, DataRng, 0))

        ChartSettings.DataStart = ChartSettings.DataStart + 1

    Loop

which is found in ClsChartUpdate.

If I replace it with another loop, such as:

Code:
Dim i As Long
  
    i = 1
  
    Do Until i = 1000000
  
        i = i + 1
  
    Loop

and comment out:

Code:
RowNumber = Application.Match(ChartSettings.DataStart, DataRng, 0)

when the code runs, I CAN attempt to change any cell and the code does NOT crash.

So why is this loop causing the code to crash?

Code:
Do Until Not IsError(Application.Match(ChartSettings.DataStart, DataRng, 0))

        ChartSettings.DataStart = ChartSettings.DataStart + 1

    Loop
 

NdNoviceHlp

Well-known Member
Joined
Nov 9, 2002
Messages
2,723

ADVERTISEMENT

Seems like a few things. The code wouldn't compile until I changed all these from...
Code:
wksData
to..
Code:
Sheets("wksData")
You also don't have a class module called "ChartSettings" so replace all them with "Settings"
Here's the test code module...
Code:
Option Explicit

Public Start As Long
Public Initial As ClsSettings
Public DateStart As ClsSettings
 
Public Sub Test()
Dim Cht As ChartObject
Start = 30685
Set Cht = Sheets("wksData").ChartObjects("Chart 1")

On Error GoTo Erfix
Do Until Start = 44124
Cht.Activate
With Application
Sheets("wksData").Range("DataStart").Value = Start
ActiveCell.Activate
Call ModChartUpdate.ChartUpdate
End With
DoEvents
Start = Start + 1
Loop
Exit Sub

Erfix:
On Error GoTo 0
MsgBox "Error"
End Sub
HTH. Dave
 

NdNoviceHlp

Well-known Member
Joined
Nov 9, 2002
Messages
2,723
Missed the edit then realized the test code ain't quite right.
Code:
Option Explicit

Public Start As Long
Public Initial As ClsSettings
Public DateStart As ClsSettings
  
Public Sub Test()
Dim Cht As ChartObject
Start = 30685
Set Cht = Sheets("wksData").ChartObjects("Chart 1")

On Error GoTo Erfix
Do Until Start = 44124
Cht.Activate
With Application
.EnableEvents = False
Sheets("wksData").Range("DataStart").Value = Start
ActiveCell.Activate
Call ModChartUpdate.ChartUpdate
.EnableEvents = True
End With
DoEvents
Start = Start + 1
Loop
Exit Sub

Erfix:
On Error GoTo 0
MsgBox "Error"
End Sub
 

tiredofit

Well-known Member
Joined
Apr 11, 2013
Messages
1,394

ADVERTISEMENT

Missed the edit then realized the test code ain't quite right.
Code:
Option Explicit

Public Start As Long
Public Initial As ClsSettings
Public DateStart As ClsSettings
 
Public Sub Test()
Dim Cht As ChartObject
Start = 30685
Set Cht = Sheets("wksData").ChartObjects("Chart 1")

On Error GoTo Erfix
Do Until Start = 44124
Cht.Activate
With Application
.EnableEvents = False
Sheets("wksData").Range("DataStart").Value = Start
ActiveCell.Activate
Call ModChartUpdate.ChartUpdate
.EnableEvents = True
End With
DoEvents
Start = Start + 1
Loop
Exit Sub

Erfix:
On Error GoTo 0
MsgBox "Error"
End Sub
Thanks for spending time looking at my problem.

Apologies about wksData. I forgot to add I changed the codename of the worksheet first.

I have pasted your Test module and ran it.

When the user attempts to change the value in a cell, your code displays the message, Error, then stops.

That's not quite what I'm looking for.

What I want is the changed cell to reverse, ie not let changes be made and then the program to continue running.
 

NdNoviceHlp

Well-known Member
Joined
Nov 9, 2002
Messages
2,723
At least U don't have to use the task manager anymore and U can make code changes for trial and error :) Your code behaves very strangely.. something related to the class modules. I think U could abandon all of that stuff and just use some global variables to achieve the same outcome. Anyways, good luck. Dave
 

tiredofit

Well-known Member
Joined
Apr 11, 2013
Messages
1,394
At least U don't have to use the task manager anymore and U can make code changes for trial and error :) Your code behaves very strangely.. something related to the class modules. I think U could abandon all of that stuff and just use some global variables to achieve the same outcome. Anyways, good luck. Dave
I agree it's weird but I've done a lot and don't really want to abandon it.

Thanks for looking at it.

I'll update if I find a solution.
 

Watch MrExcel Video

Forum statistics

Threads
1,122,240
Messages
5,595,009
Members
413,958
Latest member
SBM

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
Top