KeyUp execute code.

O

omairhe

Well-known Member
Joined
Mar 26, 2009
Messages
2,040
Office Version
  1. 2019
Platform
  1. Windows
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.
 
Sort by date Sort by votes
Sorry to bother you again but I have noticed that the Lbutton/Rbutton click would not pop up the message or run my code. Although this was not part of my requirement at first but turns out to be a must have. Also by removing the following line from your last code I've noticed that the problem been fixed ,

This is the line that I have removed
Code: 
    If vKey = vbKeyLButton Then KillTimer Application.hwnd, 0: Exit Sub
.

Now I am wondering if I did the right thing or perhaps there was a better alternative of doing it?
 
Upvote 0

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
omairhe said:
Now I am wondering if I did the right thing or perhaps there was a better alternative of doing it?
Click to expand...

I would do it this way to avoid conflict with the Enter and Tab keys : (Changes in RED)

Code: 
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
    
    [B][COLOR=#ff0000]If GetAsyncKeyState(vbKeyReturn) Then Exit Sub[/COLOR][/B]
    [B][COLOR=#ff0000]If GetAsyncKeyState(vbKeyTab) Then Exit Sub[/COLOR][/B]

    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
 
Upvote 0
Or incorporate Enter and Tab key in the code aswell. If you can't beat them join them. hehe.

Code: 
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,[COLOR=#ff0000] vbKeyReturn, vbKeyTab[/COLOR])
    vKeysNames = Array("Down", "Up", "Left", "Right", "MouseClick", [COLOR=#ff0000]"Enter", "Tab"[/COLOR])
    
    For i = 0 To UBound(vKeysArray)
        If GetAsyncKeyState(vKeysArray(i)) Then vKey = vKeysArray(i): bArrowKeyPressed = True: Exit For
    Next i


    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) [COLOR=#ff0000]+ GetAsyncKeyState(vbKeyReturn) + GetAsyncKeyState(vbKeyTab)[/COLOR] = 0
    
End Property
 
Upvote 0
Nice !

Can you show us how you incorporated the code to highlight the active row/column with conditional formatting.
 
Upvote 0
Jaafar Tribak said:
Nice !

Can you show us how you incorporated the code to highlight the active row/column with conditional formatting.
Click to expand...

Glad you've asked. Well, from the Forums I get something like this..

Code: 
Sub colourchange()    
ActiveSheet.Cells.Font.ColorIndex = 1
    With Cells(Selection.Row, 1).Font
        .ColorIndex = 4
    End With
    With Cells(1, Selection.Column).Font
        .ColorIndex = 4
    End With
End Sub

This will apply color index = 1 (black font) to entire cells.
Then it applies color index = 4 (green font) to column A and Row 1 of the intersect Cell reference.

The problem is that in my worksheet's range A1:T1000 have some colored fonts which will be defaulted to black font.

I am not trying to highlight an entire column or row just now, my workable range is U1:AZ1000 only. So for instance if I am at cell T4 . the color should be all black font. But If I move to U4, then U1 and A4 should be green font. ofcourse it should be black again if I move back to T4.

I greatly appreciate your help.
 
Last edited:
Upvote 0
Not sure I understand but if you don't have conditional formatting in your worksheet(s) it is better to not change the actual font color of the cells and use vba to temporarly highlight the cells with CF.

Here is a workbook demo where I have used the code to incorporate the CF highlighting functionality.

I have added a new pseudo-event (OnNavigationKeyDownPseudoEvent) to the initial code in order to catch the Key(s) down event.


1- Code in a Standard Module:
Code: 
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 bFirstRun As Boolean
    Static bKeyReleased As Boolean
    Static bArrowKeyWasPressed As Boolean
    Static vKey As Variant
    Dim bArrowKeyPressed As Boolean
    Dim vKeysArray As Variant, vKeysNames As Variant, i As Integer
    
    
    vKeysArray = Array(vbKeyDown, vbKeyUp, vbKeyLeft, vbKeyRight, vbKeyLButton, vbKeyReturn, vbKeyTab)
    vKeysNames = Array("{DOWN}", "{UP}", "{LEFT}", "{RIGHT}", "{LEFT-CLICK}", "{ENTER}", "{TAB}")
    
    For i = 0 To UBound(vKeysArray)
        If GetAsyncKeyState(vKeysArray(i)) Then vKey = vKeysArray(i): bArrowKeyPressed = True: Exit For
    Next i

    On Error Resume Next

    If bKeyReleased Or bFirstRun = False Then
        bFirstRun = True
        vKey = Switch(vKey = 38, "{UP}", vKey = 40, "{DOWN}", vKey = 39, "{RIGHT}", vKey = 37, _
        "{LEFT}", vKey = 13, "{ENTER}", vKey = 9, "{TAB}", vKey = 1, "{LEFT-CLICK}")
        KillTimer Application.hwnd, 0
        Call ThisWorkbook.OnNavigationKeyDownPseudoEvent(Selection, vKey)
        Call HookArrowKeys
    End If
    
    bKeyReleased = False
    vKey = vKeysNames(i)
    i = GetAsyncKeyState(vbKeyLButton)
    
    If NavigationKeyStateUp Then
        If bArrowKeyWasPressed Then
            KillTimer Application.hwnd, 0
            bKeyReleased = True
            Call ThisWorkbook.OnNavigationKeyUpPseudoEvent(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) + GetAsyncKeyState(vbKeyReturn) + GetAsyncKeyState(vbKeyTab) = 0
    
End Property


2- Code in the ThisWorkbook Module:
Code: 
Option Explicit


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


Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
    Sh.Cells.FormatConditions.Delete
End Sub


Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Cells.FormatConditions.Delete
End Sub


[B][COLOR=#008000]'=================================================================================
'                              PSEUDO-EVENTS
'=================================================================================[/COLOR][/B]


Public Sub OnNavigationKeyUpPseudoEvent(ByVal Target As Range, ByVal vKey As String)
        
    If Target.Cells.Count > 1 Then Exit Sub
    
    With Union(Target.Resize(3), Target.Resize(, 3)).FormatConditions.Add(Type:=xlExpression, Formula1:="=0=0")
        .Interior.Color = vbYellow
        .Font.Color = vbRed
        .Font.Bold = True
        .Borders(xlLeft).LineStyle = xlContinuous
        .Borders(xlRight).LineStyle = xlContinuous
        .Borders(xlTop).LineStyle = xlContinuous
        .Borders(xlBottom).LineStyle = xlContinuous
    End With
    
End Sub


Public Sub OnNavigationKeyDownPseudoEvent(ByVal Target As Range, ByVal vKey As String)

    Target.Parent.Cells.FormatConditions.Delete
    
End Sub


I hope you can adapt the code to your specific requirements.
 
Upvote 0
Thank you . I will let you know if I run into some problems.
 
Upvote 0
Would it be possible to avail Ctrl+Z for Undo?

Thank you.
 
Upvote 0
oki I got around this by applying Conditional Formatting manually.

then triggering the .calculate under "pseudo events".

Code: 
'=================================================================================
'                                                    PSEUDO-EVENTS
'=================================================================================


Public Sub OnNavigationKeyUpPseudoEvent(ByVal Target As Range, ByVal vKey As String)
        
    If Target.Cells.Count > 1 Then Exit Sub


If Application.CutCopyMode = False Then
Application.Calculate
End If
    
End Sub
 
Last edited:
Upvote 0
Dear Jaafar,

The code on post #26 has a little annoyance . For sometimes the UpKey event is not triggered. This is apparent when holding down left and right arrow keys simultaneously for more than 3 seconds, Please see the attached image.

I5tWgMW.jpg


I5tURLJ.jpg
I5tURLJ.jpg
https://pasteboard.co/I5tWgMW.jpg
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Solved
Code works when run from code window but not with hotkey.
Replies
3
Views
73
Alex Blakenburg
A
G
  • Question
Using a set date to prevent access to Excell tabs and macros
Replies
1
Views
103
Micron
M
duteberta
  • Question
VBA code to auto sort table based on any change within a specific column
2
Replies
17
Views
1K
Peter_SSs
Peter_SSs
U
  • Solved
Simple VBA code freezes/crashes Excel
Replies
2
Views
221
ubergreen
U
pbornemeier
  • Question
VBA Hangs While Producing Complex Graph
Replies
1
Views
290
frabulator
frabulator

Forum statistics

Threads
1,220,965
Messages
6,157,119
Members
451,399
Latest member
alchavar

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top