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 unfortunatelyWhy not? What happens?




If you try to run what I wrote, you can understand what I'm trying to doI 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 timeThen 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?