![]()
Sub Scroll() On Error GoTo handleCancel Application.EnableCancelKey = xlErrorHandler Sheets("Summary").Select 'applies macro to Summary sheet only Dim x As Single Dim Arr As Variant Dim Lr As Long, i As Long, j As Long, k As Long, sec As Long, z As Long Lr = Cells(Rows.Count, "B").End(xlUp).Row - 19 'originally "1" but then it scrolled too far 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 sec = 3 'pause (in seconds) before scrolling next row Range("A6").Select 'moves cursor to first unfrozen row Do For z = 0 To UBound(Arr) For i = 1 To Lr ActiveWindow.SmallScroll Down:=Arr(z) x = Timer While Timer - x < sec 'number of seconds pause (approx) Wend 'repear while procedure until Timer condition met Next i Next z j = j + 1 Loop Until j = k 'number of times scroll down and up handleCancel: If Err = 18 Then 'Escape pressed MsgBox "You canceled", , "Error found ..." Else MsgBox "Don't have a clue !!!" & vbCrLf & _ Err.Number & " - " & Err.Description, , "Error found ..." End If End Sub
Bookmarks