Bypassing change event code if arrow keys are pressed.

omairhe

Well-known Member
Joined
Mar 26, 2009
Messages
1,622
Hey all,

I have a worksheet event code
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
which works great.

Well, I want to bypass or stop using it if a specific key is being held down. In this case the arrow keys.
Reason being the arrow keys are used for scrolling through the cells. The scrolling speed is ok but the cursor will seemingly show an hour glass symbol repetitively as if precious computer resources are being used every time a cell jumps from one to another (quite annoying). Is there a way to bypass change event code for as long as the arrow keys are being pressed. Perhaps with an Api?

Ty.
 
Last edited:

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
4,254
This works for me

In SHEET module
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Application.OnKey "{RIGHT}", "MoveR"
    Application.OnKey "{LEFT}", "MoveL"
    Application.OnKey "{UP}", "MoveU"
    Application.OnKey "{DOWN}", "MoveD"
    If MoveOnly = True Then GoTo HandleMove
    
    '[COLOR=#ff0000][I]rest of your macro goes here[/I][/COLOR]

HandleMove:
    MoveOnly = False
End Sub
In a new STANDARD module
Code:
Option Explicit
Public MoveOnly As Boolean

Sub MoveL()
    Call MoveTo(0, -1)
End Sub
Sub MoveR()
    Call MoveTo(0, 1)
End Sub
Sub MoveU()
    calll MoveTo(-1, 0)
End Sub
Sub MoveD()
    Call MoveTo(1, 0)
End Sub
Sub MoveTo(r As Long, c As Long)
    Application.EnableEvents = True
    MoveOnly = True
    ActiveCell.Offset(r, c).Activate
End Sub
Question
- is your Selection_Change macro currently triggered EVERY time another cell is selected? :confused:
- (if so) is that what you want?
- can limit trigger to specific cells \ columns \ rows etc
- let me know
 

omairhe

Well-known Member
Joined
Mar 26, 2009
Messages
1,622
Thanks Yongle but I had to add Exit Sub to the code and the mouse pointer is now at peace.

eg.
Code:
[COLOR=#333333]Private Sub Worksheet_SelectionChange(ByVal Target As Range)
[/COLOR][COLOR=#333333]'my code
[B]Exit Sub[/B]
End Sub[/COLOR]
 
Last edited:

omairhe

Well-known Member
Joined
Mar 26, 2009
Messages
1,622
Well, after restarting my workbook the code will not be working anymore , perhaps something to do with Exit Sub. A fix for that is to copy the change event code and insert that into "this workbook" open event.

eg.
Code:
Private Sub Workbook_Open()
'my code
End Sub
 
Last edited:

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
5,142
Office Version
2013
Platform
Windows
Well, after restarting my workbook the code will not be working anymore , perhaps something to do with Exit Sub. A fix for that is to copy the change event code and insert that into "this workbook" open event.

eg.
Code:
Private Sub Workbook_Open()
'my code
End Sub

Try this update to some code I developed with another here which may do what you want


Place Following in Standard Module

Rich (BB code):
Public Const NavigateSheet As String = "Sheet1"
 Sub SetOnkey(ByVal state As Integer)
' Updated Jan 2019
' Authors Dave Timms (aka DMT32) and  Jerry Sullivan MVP


    If state = xlOn Then
        With Application
            .OnKey "{RIGHT}", "'Navigate xlToRight'"      'Right Arrow Key
            .OnKey "{LEFT}", "'Navigate xlToLeft'"        'Left Arrow Key
            .OnKey "{DOWN}", "'Navigate xlDown'"          'Down Arrow Key
            .OnKey "{UP}", "'Navigate xlUp'"              'Up Arrow Key
        End With
    Else
'reset keys
        With Application
            .OnKey "{RIGHT}"
            .OnKey "{LEFT}"
            .OnKey "{DOWN}"
            .OnKey "{UP}"
        End With
    End If
End Sub




Sub Navigate(ByVal Direction As XlDirection)
'  Updated Jan 2019
' Solution adapted from code created by Dave Timms (aka DMT32) and  Jerry Sullivan MVP
    Dim MoveUpDown As Integer
    Dim MoveLeftRight As Integer
    
    On Error GoTo exitsub
    Select Case Direction
    Case xlUp, xlDown
        MoveUpDown = IIf(Direction = xlUp, -1, 1)
    Case xlToLeft, xlToRight
        MoveLeftRight = IIf(Direction = xlToLeft, -1, 1)
    End Select
    
'ensure do not exceed worksheet Cell Ranges
    With ActiveCell
        MoveUpDown = IIf(.Row + MoveUpDown < 1, 0, IIf(.Row + MoveUpDown > Rows.Count, 0, MoveUpDown))
        MoveLeftRight = IIf(.Column + MoveLeftRight < 1, 0, IIf(.Column + MoveLeftRight > Columns.Count, 0, MoveLeftRight))
    End With


'turn events off
    Application.EnableEvents = False
'select cell
    ActiveCell.Offset(MoveUpDown, MoveLeftRight).Select
    
exitsub:
'turn events on
    Application.EnableEvents = True
End Sub
You will need to change the Sheet Name (shown in RED) that you want code to apply to as required


Place Following in ThisWorkbook code page

Rich (BB code):
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Sh.Name = NavigateSheet Then SetOnkey xlOn
End Sub


Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
If Sh.Name = NavigateSheet Then SetOnkey xlOff
End Sub


Private Sub Workbook_WindowActivate(ByVal Wn As Window)
If ActiveSheet.Name = NavigateSheet Then SetOnkey xlOn
End Sub
 
Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)
SetOnkey xlOff
End Sub
When you activate the specified sheet, SetOnkey code assigns arrow keys to procedure Navigate which has parameter Direction.
With each arrow key press, an argument is passed to the Navigate procedure & this is used to determine which direction your cell needs to move.

When you leave to sheet or the workbook, Onkey values are restored to their default value.

Your Selection_change event code should need no changes

Hope Helpful

Dave
 
Last edited:

Forum statistics

Threads
1,077,959
Messages
5,337,421
Members
399,145
Latest member
SPLhorses

Some videos you may like

This Week's Hot Topics

Top