How to create an auto-scroll in Excel VBA that pauses when any key is pressed?-CodePudding

I have a large amount of data to scroll through every day and an autoscroll macro that pauses when a key is pressed (and resumes with a button push) would be a big help.

So far, I've tried:

Sub Autoscroll()

Dim RowCount As Integer
Dim i As Integer

RowCount = Range("Table").Rows.Count

For i = RowCount   1 To 2 Step -1
    Range("A" & i).Select
    Application.Wait (Now   TimeValue("0:00:01"))
Next i


End Sub

But this doesn't achieve what I want for a few reasons:

It doesn't pause when I press a key
It can't go faster than 1 second. (I could use the Sleep function to make the scroll move faster)

Looking for some recommendations about the best way to do this.

Thank you

CodePudding user response：

If you insist on using a macro try this, it should do the trick (if you are using Windows!).

You have to press the return key to interrupt. If you'd prefer a different key let me know.

Option Explicit

#If VBA7 Then
    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Private Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
#Else
    Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
#End If

'Sub pausing code execution without freezing the app or causing high CPU usage
'Author: Guido Witt-Dörring, https://stackoverflow.com/a/74387976/12287457
Public Sub WaitSeconds(ByVal seconds As Single)
    Const VK_RETURN = &HD
    Dim currTime As Single, endTime As Single, cacheTime As Single
    currTime = Timer(): endTime = currTime   seconds: cacheTime = currTime
    Do While currTime < endTime
        If GetAsyncKeyState(VK_RETURN) Then
            Sleep 200
            Do Until GetAsyncKeyState(VK_RETURN)
                DoEvents: Sleep 15
            Loop
            Sleep 200
        End If
        DoEvents: Sleep 15: currTime = Timer()
        'The following is necessary because the Timer() function resets at 00:00
        If currTime < cacheTime Then endTime = endTime - 86400! 'seconds per day
        cacheTime = currTime
    Loop
End Sub

Sub Autoscroll()
    Dim RowCount As Long
    Dim i As Long
    RowCount = Range("Table").Rows.Count
    For i = RowCount   1 To 2 Step -1
        WaitSeconds 0.5 '<-- this is how long it waits at every row,
        Range("A" & i).Select 'set it to your desired value
    Next i
End Sub