Bypassing change event code if arrow keys are pressed.

[omairhe]

Hey all,

I have a worksheet event 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.

 

[Yongle]

This works for me

In SHEET module

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

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?
- (if so) is that what you want?
- can limit trigger to specific cells \ columns \ rows etc
- let me know

 

[omairhe]

Thanks Yongle but I had to add Exit Sub to the code and the mouse pointer is now at peace.

eg.

[COLOR=#333333]Private Sub Worksheet_SelectionChange(ByVal Target As Range)
[/COLOR][COLOR=#333333]'my code
[B]Exit Sub[/B]
End Sub[/COLOR]

 

[omairhe]

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.

Private Sub Workbook_Open()
'my code
End Sub

 

[dmt32]

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.

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

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

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

 

[omairhe]

Appreciate it. I'm still learning.

 

[dmt32]

Appreciate it. I'm still learning.

welcome - hope solution helpful

Dave