DoEvent, allow value change without stopping code

[tiredofit]

In the code below, I have added DoEvents, so the user can do something whilst the loop takes place.

Option Explicit

Sub Test()

    Dim i As Long
    
    For i = 1 To 10000
    
        Sheet1.Cells(i, 1).Value = i
        
        Application.Wait (Now + TimeValue("0:00:01"))
        
        DoEvents
        
    Next i
    
End Sub

However, when the code is running, if I select a cell on the worksheet and change its value, the code stops.

How can I allow the user to change a value on the worksheet without the code stopping?

Thanks

 

[Legacy 456155]

I would change your approach and use the built in events to determine when some range is changed. If, for some reason, you must hold your course, you could use an API timer. Maybe you might provide a bigger picture of what you are trying to do for some better suggestions.

 

[tiredofit]

I have a graph that scrolls when the play button is clicked.

However I also want the user to be able to stop it any time time by clicking the stop button.

To enable that functionality, I added a DoEvents command.

But that means the user can freely click on any cell on the worksheet. In doing so, the graph stops playing when it shouldn't. The only time the graph should stop is when the stop button is clicked.

 

[Legacy 456155]

My first thought would be to create a small, modal userform, run your scrolling code from there, along with your dovents loop, looking for a button click. That would disallow interaction with the worksheet while the graph is doing its thing. Let me know what you think.

 

[tiredofit]

My first thought would be to create a small, modal userform, run your scrolling code from there, along with your dovents loop, looking for a button click. That would disallow interaction with the worksheet while the graph is doing its thing. Let me know what you think.

Thanks, I'll give it a go and get back shortly.

 

[Trixterz]

Well, the DoEvents is improved, but still the same results.

Option Explicit
Sub Test()
    Dim I As Long, CTimer As String
    I = 1: CTimer= Now
    
    Application.Calculation = xlCalculationManual
    
    Do Until I = 10
        If CTimer <> Now Then
            Sheet1.Cells(I, 1).Value = I
            I = I + 1: CTimer = Now
        End If
        DoEvents
    Loop
    
    Application.Calculation = xlCalculationAutomatic
    'MsgBox "Completed"
End Sub

 

[Jaafar Tribak]

Well, the DoEvents is improved, but still the same results.

If you ignore the error and and wait until edit mode is finished, you can resume the loop from where it stopped.

Something along these lines may work:

Sub Test()

    Dim I As Long, CTimer As String
    I = 1: CTimer = Now

    Application.Calculation = xlCalculationManual
   
    On Error Resume Next

    Do Until I = 10
        If CTimer <> Now Then
           If Application.CommandBars.GetEnabledMso("MergeCenter") Then
               Sheet1.Cells(I, 1).Value = I
               I = I + 1: CTimer = Now
           End If
        End If
        DoEvents   
    Loop

    Application.Calculation = xlCalculationAutomatic

    MsgBox "Completed"
   
End Sub

 

[tiredofit]

My first thought would be to create a small, modal userform, run your scrolling code from there, along with your dovents loop, looking for a button click. That would disallow interaction with the worksheet while the graph is doing its thing. Let me know what you think.

I added a userform and this code:

Option Explicit

Private Sub CommandButton1_Click()

    Call Module1.Test
    
End Sub

When I click on the button on the userform, the above code runs. It's ShowModal property is set to False (which allows me to click on the worksheet when the code is running).

When I change the value in a cell on the worksheet, the code stops, as it did without the userform.

 

[tiredofit]

If you ignore the error and and wait until edit mode is finished, you can resume the loop from where it stopped.

Something along these lines may work:

Sub Test()

    Dim I As Long, CTimer As String
    I = 1: CTimer = Now

    Application.Calculation = xlCalculationManual
  
    On Error Resume Next

    Do Until I = 10
        If CTimer <> Now Then
           If Application.CommandBars.GetEnabledMso("MergeCenter") Then
               Sheet1.Cells(I, 1).Value = I
               I = I + 1: CTimer = Now
           End If
        End If
        DoEvents  
    Loop

    Application.Calculation = xlCalculationAutomatic

    MsgBox "Completed"
  
End Sub

Thanks, it HAS worked!

Would I be correct in saying this is the critical line of code for making it work?

Application.CommandBars.GetEnabledMso("MergeCenter")

Can you explain what it's doing?

 

[Jaafar Tribak]

Thanks, it HAS worked!

Would I be correct in saying this is the critical line of code for making it work?

Application.CommandBars.GetEnabledMso("MergeCenter")

Can you explain what it's doing?

Correct... that line is there to check if the sheet is in edit mode and if so, wait until edit mode is finished.