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.

 

[omairhe]

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

    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?

 

[Jaafar Tribak]

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

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

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

 

[omairhe]

Or incorporate Enter and Tab key in the code aswell. If you can't beat them join them. hehe.

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

 

[Jaafar Tribak]

Nice !

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

 

[omairhe]

Nice !

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

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

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.

 

[Jaafar Tribak]

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:

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:

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.

 

[omairhe]

Thank you . I will let you know if I run into some problems.

 

[omairhe]

Would it be possible to avail Ctrl+Z for Undo?

Thank you.

 

[omairhe]

oki I got around this by applying Conditional Formatting manually.

then triggering the .calculate under "pseudo events".

'=================================================================================
'                                                    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

 

[omairhe]

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.

https://pasteboard.co/I5tWgMW.jpg