I've *replaced the original button with a toggle button that determines whether or not the sheet will scroll.
code (below) & I've also reuploaded the excel workbook with the toggle button. I tested the solution, and it works well. Sorry I misunderstood your original question.
Sub scroll()
On Error GoTo HandleCancel
Application.EnableCancelKey = xlErrorHandler
Sheets("Summary").Select 'applies macro to Summary sheet only
Dim x As Single, y As Single, n As Single, vis As Single 'n is number of players, vis is number of rows visible on screen
Dim Arr As Variant
Dim i As Long, j As Long, k As Long, sec As Long, z As Long
Dim scroll As Integer
n = Worksheets("Live Score Sheet").Range("D137").Value ' number of players
sec = Worksheets("Live Score Sheet").Range("D139").Value ' scroll row delay
vis = Worksheets("Live Score Sheet").Range("D141").Value - 1 ' visible rows
scr = Worksheets("Live Score Sheet").Range("D143").Value ' scroll time (seconds)
Arr = Array(1, -1) 'set up array containing 2 values to control direction of scroll (up or down)
j = 0 'initialise scroll count
k = 10000 ' number of times the scores scroll down and up (effectively continuous)
'sec = 2 'pause (in seconds) before scrolling next row
'vis = 8 'number of player's scores visible on screen
'Controls the Scroll "Toggle Button" text
If Sheet4.ToggleButton1 = True Then
With Sheet4.ToggleButton1
.Caption = "Scroll On"
End With
ElseIf Sheet4.ToggleButton1 = False Then
With Sheet4.ToggleButton1
.Caption = "Scroll Off"
End With
End If
Range("A6").Select 'moves cursor to first unfrozen row
scroll = 1
If n > vis Then
y = Timer
While Timer - y < scr And Sheet4.ToggleButton1 = True 'max number of seconds of scrolling, & will run while the togglebutton is pressed/ = true
For z = 0 To UBound(Arr)
For i = 1 To n - vis
ActiveWindow.SmallScroll Down:=Arr(z)
x = Timer
While Timer - x < sec 'number of seconds pause (approx)
DoEvents
Wend 'repeat while procedure until Timer condition met
Next i
Next z
Wend
HandleCancel:
If Err = 18 Then 'Escape pressed
Range("A6").Select 'moves cursor to first unfrozen row
ElseIf Err = 0 Then 'No error
Range("A6").Select 'moves cursor to first unfrozen row
Else
Range("A6").Select 'moves cursor to first unfrozen row
MsgBox "Don't have a clue !!!" & vbCrLf & _
Err.Number & " - " & Err.Description, , "Error found ..."
End If
End If
End Sub
Bookmarks