KeyUp execute code.

[omairhe]

Hey excel gurus,

I would need your help on running a specific code when key state is up. I am already aware of a OnKey method but that is not what I require.

Another way of achieving this would be to use AutoHotKey. With a hotkey assigned to the excel macro that gets triggered on key up state that works only on excel.

will appreciate.
Thank you.

 

[Jaafar Tribak]

I'll be logging off shortly but i'll try writing some code for the arrow keys later ... Stay tuned.

 

[omairhe]

I'll be logging off shortly but i'll try writing some code for the arrow keys later ... Stay tuned.

Just so you know, the arrow keys need to keep their functionality while the key up should keep its functionality at the same time.

 

[omairhe]

for instance if "a" were to held down. the cell should keep writing letter a but when released pop up message or run macro. same with the arrow keys.

Thanks.

 

[Jaafar Tribak]

Try this :

1- In a Standard Module :

Option Explicit

[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    Private Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
    Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
    Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If


Public Sub HookArrowKeys()
    SetTimer Application.hwnd, 0, 0, AddressOf WatchKeyState    
End Sub


Public Sub UnHookArrowKeys()
   KillTimer Application.hwnd, 0   
End Sub



Private Sub WatchKeyState()

    Dim vKey As Variant, vKeysArray As Variant, vKeysNames As Variant, i As Integer
    
    vKeysArray = Array(vbKeyDown, vbKeyUp, vbKeyLeft, vbKeyRight, vbKeyLButton)
    vKeysNames = Array("Down", "Up", "Left", "Right", "MouseClick")
    
    For i = 0 To UBound(vKeysArray)
        If GetAsyncKeyState(vKeysArray(i)) Then vKey = vKeysArray(i): Exit For
    Next i
    
    If vKey = vbKeyLButton Then KillTimer Application.hwnd, 0: Exit Sub
    
    On Error Resume Next
    vKey = vKeysNames(i)
    i = GetAsyncKeyState(vbKeyLButton)
     
    If NavigationKeyStateUp Then
        KillTimer Application.hwnd, 0
        Call OnKeyUpPseudoEvent(Selection, CStr(vKey))
    End If
    
End Sub


Private Property Get NavigationKeyStateUp() As Boolean
    
    NavigationKeyStateUp = GetAsyncKeyState(vbKeyDown) + GetAsyncKeyState(vbKeyUp) _
    + GetAsyncKeyState(vbKeyLeft) + GetAsyncKeyState(vbKeyRight) = 0
    
End Property




[B][COLOR=#008000]'=================================================================================
'                                 PSEUDO-EVENT
'=================================================================================[/COLOR][/B]
Private Sub OnKeyUpPseudoEvent(ByVal Target As Range, ByVal vKey As String)
    MsgBox "You Relased the '" & vKey & "' Key" & vbNewLine & "At cell : '" & Target.Address & "'"
End Sub
[B][COLOR=#008000]'==================================================================================[/COLOR][/B]

2- In the Workbook Module :

Option Explicit

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Call HookArrowKeys
End Sub

Now just navigate the worksheet(s) with the UP,DOWN,RIGHT,LEFT keys and the MsgBox located in then OnKeyUpPseudoEvent routine should pop up when releasing the keys.

 

[Jaafar Tribak]

Oops! there was a bug in the previous code - Please, ignore it and use the following one


-In a Standard Module

Option Explicit

[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  VBA7 Then
    Private Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
    Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
    Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
    Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If


Public Sub HookArrowKeys()

    SetTimer Application.hwnd, 0, 0, AddressOf WatchKeyState
    
End Sub


Public Sub UnHookArrowKeys()

   KillTimer Application.hwnd, 0
   
End Sub


Private Sub WatchKeyState()

    Static vKey As Variant
    Dim vKeysArray As Variant, vKeysNames As Variant, i As Integer
    
    vKeysArray = Array(vbKeyDown, vbKeyUp, vbKeyLeft, vbKeyRight, vbKeyLButton)
    vKeysNames = Array("Down", "Up", "Left", "Right", "MouseClick")
    
    For i = 0 To UBound(vKeysArray)
        If GetAsyncKeyState(vKeysArray(i)) Then vKey = vKeysArray(i): Exit For
    Next i
    
    If vKey = vbKeyLButton Then KillTimer Application.hwnd, 0: Exit Sub
    
    On Error Resume Next
    vKey = vKeysNames(i)
    i = GetAsyncKeyState(vbKeyLButton)
     
    If NavigationKeyStateUp Then
        KillTimer Application.hwnd, 0
        Call OnKeyUpPseudoEvent(Selection, CStr(vKey))
    End If
    
End Sub


Private Property Get NavigationKeyStateUp() As Boolean
    
    NavigationKeyStateUp = GetAsyncKeyState(vbKeyDown) + GetAsyncKeyState(vbKeyUp) _
    + GetAsyncKeyState(vbKeyLeft) + GetAsyncKeyState(vbKeyRight) = 0
    
End Property



[B][COLOR=#008000]'=================================================================================
'                                 PSEUDO-EVENT
'=================================================================================
[/COLOR][/B]
Private Sub OnKeyUpPseudoEvent(ByVal Target As Range, ByVal vKey As String)
    
    MsgBox "You Relased the '" & vKey & "' Key" & vbNewLine & "At cell : '" & Target.Address & "'"
    
End Sub

[B][COLOR=#008000]'==================================================================================[/COLOR][/B]

 

[Jaafar Tribak]

I have revised the code properly at home and have found a couple of bugs that went unnoticed ... I have fixed them and have updated the code as follows:

Here is a workbook example


Code update:

1- In a Standard Module:

Option Explicit

[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    Private Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
    Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
    Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If


Public Sub HookArrowKeys()

    SetTimer Application.hwnd, 0, 0, AddressOf WatchKeyState

End Sub


Private Sub WatchKeyState()
    
    Static vKey As Variant
    Static bArrowKeyWasPressed As Boolean
    Dim bArrowKeyPressed As Boolean
    Dim vKeysArray As Variant, vKeysNames As Variant, i As Integer
     
    vKeysArray = Array(vbKeyDown, vbKeyUp, vbKeyLeft, vbKeyRight, vbKeyLButton)
    vKeysNames = Array("Down", "Up", "Left", "Right", "MouseClick")
    
    For i = 0 To UBound(vKeysArray)
        If GetAsyncKeyState(vKeysArray(i)) Then vKey = vKeysArray(i): bArrowKeyPressed = True: Exit For
    Next i

    If vKey = vbKeyLButton Then KillTimer Application.hwnd, 0: Exit Sub

    On Error Resume Next
    vKey = vKeysNames(i)
    i = GetAsyncKeyState(vbKeyLButton)
    
    If NavigationKeyStateUp Then
        If bArrowKeyWasPressed Then
            KillTimer Application.hwnd, 0
            Call ThisWorkbook.OnArrowKeyUpPseudoEvent(Selection, CStr(vKey))
        End If
    End If
  
    bArrowKeyWasPressed = bArrowKeyPressed
    If bArrowKeyPressed = False Then KillTimer Application.hwnd, 0
    
End Sub


Private Property Get NavigationKeyStateUp() As Boolean
    
    NavigationKeyStateUp = GetAsyncKeyState(vbKeyDown) + GetAsyncKeyState(vbKeyUp) _
    + GetAsyncKeyState(vbKeyLeft) + GetAsyncKeyState(vbKeyRight) = 0
    
End Property

2- In the ThisWorkbook Module:

Option Explicit


Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

    Call HookArrowKeys

End Sub


[COLOR=#008000][B]'=================================================================================
'                           PSEUDO-EVENT
'=================================================================================[/B][/COLOR]
Public Sub OnArrowKeyUpPseudoEvent(ByVal Target As Range, ByVal vKey As String)
    
    MsgBox "{" & vKey & "} arrow Key released" & " [MENTION=167149]cell[/MENTION] : ''" & _
    Target.Parent.Name & "!" & Target.Address & "''", vbInformation
    
    [B][COLOR=#008000]'OTHER EXISTING CODE GOES HERE ....[/COLOR][/B]
    
End Sub
[B][COLOR=#008000]'==================================================================================[/COLOR][/B]

Despite using a windows timer + callback , the code should be stable... Also, the timer doesn't have a real impact on performance as the timer is only activated for a very short time while navigating the worksheet(s) until the Arrow keys are released and stops immediately thereafter.

 

[omairhe]

Thank you so much,

This brought a smile on my face. Kudos.

 

[Jaafar Tribak]

Thank you so much,

This brought a smile on my face. Kudos.

Happy to to have helped.

I am assuming you have used the code in post#16 - Right ?

 

[omairhe]

Happy to to have helped.

I am assuming you have used the code in post#16 - Right ?

Yes my intital response was for the previous code as that worked aswell but then I updated to post#16 and it is all good now.

I was in search for something like this for a long time. Highlighting the row while selection is on the move can be distracting because I wanted to highlight the selected row only when seletion was at rest meannig on keyup state, so that the fonts in the first cells of the selected row and column shall be colored into green . we have conditional formatting and vba codes and even Kutools for that but the code you presented is quite sleek and right on the money.

 

[Jaafar Tribak]

omairhe

Excellent ! I too have learnt in the process as this was quite a challenging question and is not a common request with excel

Thanks for the feedback.