Allow users to intercept when code is running

[tiredofit]

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:

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:

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:

Option Explicit

Public Sub ChartUpdate()

    Dim UpdateChart As ClsChartUpdate
    Set UpdateChart = New ClsChartUpdate

    Call UpdateChart.ChartUpdate

    Set UpdateChart = Nothing
  
End Sub

ModReverse:

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 :

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:

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:

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:

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:

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

 

[GWteB]

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]

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:

ActiveCell.Activate
               
Call ModChartUpdate.ChartUpdate

and the chart gets updated.

Essentially the "working" version is doing this:

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:

Call Sub C

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

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

I even tried adding this in wksData:

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

then in Test, refer to it:

Call wksData.Workaround

but it still failed.

 

[tiredofit]

I have done some research and have found this is the code at fault:

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:

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

and comment out:

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?

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

        ChartSettings.DataStart = ChartSettings.DataStart + 1

    Loop

 

[NdNoviceHlp]

Seems like a few things. The code wouldn't compile until I changed all these from...

wksData

to..

Sheets("wksData")

You also don't have a class module called "ChartSettings" so replace all them with "Settings"
Here's the test code module...

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]

Missed the edit then realized the test code ain't quite right.

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]

Missed the edit then realized the test code ain't quite right.

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]

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]

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.