Sheets change every few seconds in a loop

[xxyaniv]

hi,
I want to broadcast the Excel file I have created on the screen so that it will run an endless loop of sheets at any given time that I will set until I press CTRL BREAK.
I use Office 2016. That's what I've done. He looks good and he really works, but after severl times that i play and stop him he just stops suddenly.
I would be happy if you could help me resolve the matter or give me another suggestion. As I said - I want the Excel sheets to run one loop after the other (for a while) until the exit. (i need a simply exit because this is a simple user who does not understand Excel very well).
thanks,
yaniv

my macro:

Sub Yaniv()

    Application.EnableCancelKey = xlErrorHandler
    On Error GoTo Error:

    Do Until False
    Sheets(1).Select
        Range("AR8").Select
        ActiveWindow.ScrollColumn = 1
        ActiveWindow.SmallScroll Down:=-100000
        Application.Wait (Now + TimeValue("00:00:03"))
        
    Sheets(1).Select
        ActiveWindow.ScrollColumn = 1
        ActiveWindow.SmallScroll Down:=-100000
        ActiveWindow.SmallScroll Down:=36
        Application.Wait (Now + TimeValue("00:00:03"))

    Sheets(1).Select
        ActiveWindow.ScrollColumn = 1
        ActiveWindow.SmallScroll Down:=-100000
        ActiveWindow.SmallScroll Down:=72
        Application.Wait (Now + TimeValue("00:00:03"))
        
    Sheets(2).Select
        Range("AR8").Select
        Application.Wait (Now + TimeValue("00:00:03"))

    Sheets(3).Select
        Range("AR8").Select
        Application.Wait (Now + TimeValue("00:00:03"))
    Loop
    
    Exit Sub
Error:
    If Err.Number = 18 Then
        Debug.Print "break key hit"
    Else
        Debug.Print "other error: "; Err.Number, Err.Description
    End If
End Sub

[SamT]

ThisWorkbook Code PAge...

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
End 'Stop all running code
End Sub

Module1 Code Page...

Sub SamT()
Dim Sht as Object

For each Sht in ThisWorkbook.Sheets
   Sht.Range("AR8").Select

   If Sht Is Sheets(1) then
       With ActiveWindow
        .ScrollColumn = 1
        .SmallScroll Down:=100000 '?
        Application.Wait (Now + TimeValue("00:00:03")) 
 
        .ScrollColumn = 1
        .SmallScroll Down:=100036 '? Probably just 36
      End with
  End If
  Application.Wait (Now + TimeValue("00:00:03"))
Next
End Sub

The User only has to click anywhere on any sheet to stop the code running

[xxyaniv]

Thank you very much for trying to help
But it does not work for me unfortunately
If you try to run what I wrote, you can understand what I'm trying to do
The first time you run it works well. But after several times it suddenly enough to work after one step.
Anyway thank you for trying to help!
yaniv

[SamT]

But it does not work for me unfortunately

Why not? What happens?

If you try to run what I wrote, you can understand what I'm trying to do

I understand quite well, thank you.



Do you have any other processes going on while your code is running?

[xxyaniv]

Why not? What happens?



I understand quite well, thank you.

Do you have any other processes going on while your code is running?

no.

I get run time error 1004
But anyway, it's not a loop.
I just wanted to make sure that you understand. I do not speak the language 100% and sometimes I'm not clear

[SamT]

Error 1004 = "Application-defined or Object-defined error"
Next time look it up for us, We should not have to do the research when the answer is right in front of you. Nobody can remember all 9,999,999,999,999... Errors numbers in VBA

You said

it will run an endless loop of sheets at any given time

Then you said

But anyway, it's not a loop.

Now I realy don't understand

[xxyaniv]

Error 1004 = "Application-defined or Object-defined error"
Next time look it up for us, We should not have to do the research when the answer is right in front of you. Nobody can remember all 9,999,999,999,999... Errors numbers in VBA

You said Then you said
Now I realy don't understand

I meant that what you wrote is without a loop.
I did not mean to go into an argument with you, I'm just trying to solve the problem.


The macro I am trying to write should contain an infinite loop that runs parts in one sheet and in different sheets for a time that I define in advance. The goal is for the document to be displayed on a TV screen all the time in the background.
If you can help, I will appreciate it very much

[SamT]

Try these two

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Address <> "$AR$8" Then End  'Stop all running code
End Sub

Option Explicit

Sub SamT()
Dim Sht As Object

Do
For Each Sht In ThisWorkbook.Sheets
 Sht.Activate

   Range("AR8").Select

   If Sht Is Sheets(1) Then
       With ActiveWindow
        .ScrollColumn = 1
        .SmallScroll Down:=100 '?
        Application.Wait (Now + TimeValue("00:00:03"))
        DoEvents
 
        .ScrollColumn = 1
        .SmallScroll Down:=36 '? Probably just 36
      End With
  End If
  Application.Wait (Now + TimeValue("00:00:03"))
        DoEvents
Next
Loop
End Sub

They work on my computer.

[xxyaniv]

Try these two

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Address <> "$AR$8" Then End  'Stop all running code
End Sub

Option Explicit

Sub SamT()
Dim Sht As Object

Do
For Each Sht In ThisWorkbook.Sheets
 Sht.Activate

   Range("AR8").Select

   If Sht Is Sheets(1) Then
       With ActiveWindow
        .ScrollColumn = 1
        .SmallScroll Down:=100 '?
        Application.Wait (Now + TimeValue("00:00:03"))
        DoEvents
 
        .ScrollColumn = 1
        .SmallScroll Down:=36 '? Probably just 36
      End With
  End If
  Application.Wait (Now + TimeValue("00:00:03"))
        DoEvents
Next
Loop
End Sub

They work on my computer.

Hi
It works
Thank you very much!!

[SamT]

you still have problems?

[xxyaniv]

yes.
Like I said, I finished preparing the Excel file (it contains two more codes that altogether filter two columns).
I added all the codes as buttons (in a new tab) I tried both using the Excel itself and using the Custom UI Editor for Microsoft Office and both of them I get the following error:
"application-defined or object-defined error"
At the end of each code (after it is finished).
I tried all sorts of ways and realized that this was happening because of the code you brought me that causes the code to stop by clicking the mouse button.
It:
Private Sub Workbook_SheetSelectionChange (ByVal Sh As Object, ByVal Target As Range)
If Target.Address <> "$ AR $ 8" Then End 'Stop all running code
End Sub

Can you solve this in your opinion? thanks in advance!
yaniv

[SamT]

I'm using Excel XP so I can't duplicate your error. All Changes Noted with comment Arrow

Option Explicit

Dim Continue as Boolean '<------------

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Address <> "$AR$8" Then Continue = False  '<------------

End Sub



Sub SamT()
Dim Sht As Object
Continue = True '<------------

Do While Continue  '<------------

For Each Sht In ThisWorkbook.Sheets
 Sht.Activate

   Range("AR8").Select

   If Sht Is Sheets(1) Then
       With ActiveWindow
        .ScrollColumn = 1
        .SmallScroll Down:=100 '?
        Application.Wait (Now + TimeValue("00:00:03"))
        DoEvents
 
        .ScrollColumn = 1
        .SmallScroll Down:=36 '? Probably just 36
      End With
  End If
  Application.Wait (Now + TimeValue("00:00:03"))
        DoEvents
Next
Loop
Sheets(1).Activate  '<------------
End Sub

[xxyaniv]

Unfortunately it does not work
Can I append the file partially so you can see it?

[SamT]

Unfortunately it does not work

That helps me see the problem... Not.
You must provide more details.

I use XP, you use 2007 or later. What works for me might not work for you.

[xxyaniv]

I'm using Office 2016
And these are all the codes that are written in the file. In the end I want to run them all using menu buttons.

Option Explicit
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Address <> "$AR$8" Then End  'Stop all running code
End Sub

Sub  samT (control As IRibbonControl)
Dim Sht As Object

Do
For Each Sht In ThisWorkbook.Sheets
 Sht.Activate

   Range("AR8").Select

   If Sht Is Sheets(1) Then
       With ActiveWindow
        .ScrollColumn = 1
        .SmallScroll Down:=-100
        Application.Wait (Now + TimeValue("00:00:03"))
        DoEvents
 
        .ScrollColumn = 1
        .SmallScroll Down:=-100
        .SmallScroll Down:=34
        Application.Wait (Now + TimeValue("00:00:03"))
        DoEvents

        .ScrollColumn = 1
        .SmallScroll Down:=-100
        .SmallScroll Down:=68
        Application.Wait (Now + TimeValue("00:00:03"))
        DoEvents
        
      End With
  End If
  

     If Sht Is Sheets(2) Then
       With ActiveWindow
        .ScrollColumn = 1
        .SmallScroll Down:=-100
        Application.Wait (Now + TimeValue("00:00:03"))
        DoEvents
 
        .ScrollColumn = 1
        .SmallScroll Down:=-100
        .SmallScroll Down:=34
        Application.Wait (Now + TimeValue("00:00:03"))
        DoEvents

        DoEvents
        
      End With
  End If
  
Next
Loop
End Sub



Sub License_Filter(control As IRibbonControl)
'
' License_Filter îà÷øå
'


'
    ActiveWorkbook.Worksheets("øëáé àåöø").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("øëáé àåöø").AutoFilter.Sort.SortFields.Add Key:= _
        Range("I3:I98"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("øëáé àåöø").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With


End Sub


Sub Test_Filter(control As IRibbonControl)
'
' Test_Filter îà÷øå
'


    ActiveWorkbook.Worksheets("øëáé àåöø").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("øëáé àåöø").AutoFilter.Sort.SortFields.Add Key:= _
        Range("H3:H98"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("øëáé àåöø").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With


End Sub

From what I noticed, what causes the problem is the code that stops the loop of the endless code running in the background - the first code I added here that you wrote me a few weeks ago.
Can you change it to different version?

[SamT]

the first code I added here that you wrote me a few weeks ago.
Can you change it to different version?

See my Post #12

[xxyaniv]

See my Post #12

I tried it. That does not work either. The problem persists.

[Bob Phillips]

It might help if you could post your workbook for us to look at, but I have to ask, why on earth do you want it looping round like that?

[xxyaniv]

It might help if you could post your workbook for us to look at, but I have to ask, why on earth do you want it looping round like that?

Basically it should run on a TV screen all the time until a file is needed.
I am attaching the file. I would be happy if you could find a solution
By the way, as long as the code is not set as a button it works great.
Once I add it to the menu (also using Excel only) -also any other code in the file - gives an error message after it.

[xxyaniv]

Basically it should run on a TV screen all the time until a file is needed.
I am attaching the file. I would be happy if you could find a solution
By the way, as long as the code is not set as a button it works great.
Once I add it to the menu (also using Excel only) -also any other code in the file - gives an error message after it.

Anyone?