Is there any event that fires when I press a key while editing a cell?

Question

Is it possible to fix events in any way when a key is pressed (make editing) of a certain cell on a sheet?

The closest of them is the Change event, but it can be activated only after the edited cell is canceled. I want to capture an event while editing a cell.

Answer 1

Here is the answer, I tested the same thing and it works correctly for me.

Track keystroke in Excel

An interesting question: The MS Excel Worksheet_Change event always fires when you are done with the changes and exit the cell. Capture Key Press events. Keypress event tracking is not possible using standard or built-in functions.

This can be achieved using the API .

 Option Explicit Private Type POINTAPI x As Long y As Long End Type Private Type MSG hwnd As Long Message As Long wParam As Long lParam As Long time As Long pt As POINTAPI End Type Private Declare Function WaitMessage Lib "user32" () As Long Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" _ (ByRef lpMsg As MSG, ByVal hwnd As Long, _ ByVal wMsgFilterMin As Long, _ ByVal wMsgFilterMax As Long, _ ByVal wRemoveMsg As Long) As Long Private Declare Function TranslateMessage Lib "user32" _ (ByRef lpMsg As MSG) As Long Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" _ (ByVal hwnd As Long, _ ByVal wMsg As Long, _ ByVal wParam As Long, _ lParam As Any) As Long Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As String, _ ByVal lpWindowName As String) As Long Private Const WM_KEYDOWN As Long = &H100 Private Const PM_REMOVE As Long = &H1 Private Const WM_CHAR As Long = &H102 Private bExitLoop As Boolean Sub TrackKeyPressInit() Dim msgMessage As MSG Dim bCancel As Boolean Dim iKeyCode As Integer Dim lXLhwnd As Long On Error GoTo errHandler: Application.EnableCancelKey = xlErrorHandler 'initialize this boolean flag. bExitLoop = False 'get the app hwnd. lXLhwnd = FindWindow("XLMAIN", Application.Caption) Do WaitMessage 'check for a key press and remove it from the msg queue. If PeekMessage _ (msgMessage, lXLhwnd, WM_KEYDOWN, WM_KEYDOWN, PM_REMOVE) Then 'strore the virtual key code for later use. iKeyCode = msgMessage.wParam 'translate the virtual key code into a char msg. TranslateMessage msgMessage PeekMessage msgMessage, lXLhwnd, WM_CHAR, _ WM_CHAR, PM_REMOVE 'for some obscure reason, the following 'keys are not trapped inside the event handler 'so we handle them here. If iKeyCode = vbKeyBack Then SendKeys "{BS}" If iKeyCode = vbKeyReturn Then SendKeys "{ENTER}" 'assume the cancel argument is False. bCancel = False 'the VBA RaiseEvent statement does not seem to return ByRef arguments 'so we call a KeyPress routine rather than a propper event handler. Sheet_KeyPress _ ByVal msgMessage.wParam, ByVal iKeyCode, ByVal Selection, bCancel 'if the key pressed is allowed post it to the application. If bCancel = False Then PostMessage _ lXLhwnd, msgMessage.Message, msgMessage.wParam, 0 End If End If errHandler: 'allow the processing of other msgs. DoEvents Loop Until bExitLoop End Sub Sub StopKeyWatch() 'set this boolean flag to exit the above loop. bExitLoop = True End Sub '\\This example illustrates how to catch worksheet '\\Key strokes in order to prevent entering numeric '\\characters in the Range "A1:D10" . Private Sub Sheet_KeyPress(ByVal KeyAscii As Integer, _ ByVal KeyCode As Integer, _ ByVal Target As Range, _ Cancel As Boolean) Const MSG As String = _ "Numeric Characters are not allowed in" & _ vbNewLine & "the Range: """ Const TITLE As String = "Invalid Entry !" If Not Intersect(Target, Range("A1:D10")) Is Nothing Then If Chr(KeyAscii) Like "[0-9]" Then MsgBox MSG & Range("A1:D10").Address(False, False) _ & """ .", vbCritical, TITLE Cancel = True End If End If End Sub 

Answer 2

I know this is an old question, but I recently needed similar functionality, and the answer provided had some limitations that I had to deal with how it handled (or did not handle) Del, Backspace, function keys, etc.

The fix is ​​to return the original message instead of the translated one.

The use of the class module with events has also changed, since it works fine in Excel 2010, and I did not want to copy the same code to multiple sheets:

Class module

 Option Explicit Private Type POINTAPI x As Long y As Long End Type Private Type MSG hwnd As Long Message As Long wParam As Long lParam As Long time As Long pt As POINTAPI End Type Private Declare Function WaitMessage Lib "user32" () As Long Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" _ (ByRef lpMsg As MSG, ByVal hwnd As Long, _ ByVal wMsgFilterMin As Long, _ ByVal wMsgFilterMax As Long, _ ByVal wRemoveMsg As Long) As Long Private Declare Function TranslateMessage Lib "user32" _ (ByRef lpMsg As MSG) As Long Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" _ (ByVal hwnd As Long, _ ByVal wMsg As Long, _ ByVal wParam As Long, _ lParam As Any) As Long Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As String, _ ByVal lpWindowName As String) As Long Private Const WM_KEYDOWN As Long = &H100 Private Const PM_REMOVE As Long = &H1 Private Const WM_CHAR As Long = &H102 Private bExitLoop As Boolean Public Event KeyPressed (ByVal KeyAscii As Integer, _ ByVal KeyCode As Integer, _ ByVal Target As Range, _ ByRef Cancel As Boolean) Public Sub StartKeyPressInit() Dim msgMessage As MSG Dim bCancel As Boolean Dim iMessage As Integer Dim iKeyCode As Integer Dim lXLhwnd As Long On Error GoTo errHandler Application.EnableCancelKey = xlErrorHandler 'Initialize this boolean flag. bExitLoop = False 'Get the app hwnd. lXLhwnd = FindWindow("XLMAIN", Application.Caption) Do WaitMessage 'Exit the loop if we were aborted If bExitLoop Then Exit Do 'Check for a key press and remove it from the msg queue. If PeekMessage(msgMessage, lXLhwnd, WM_KEYDOWN, WM_KEYDOWN, PM_REMOVE) Then 'Store the virtual key code for later use. iMessage = msgMessage.Message iKeyCode = msgMessage.wParam 'Translate the virtual key code into a char msg. TranslateMessage msgMessage PeekMessage msgMessage, lXLhwnd, WM_CHAR, WM_CHAR, PM_REMOVE bCancel = False RaiseEvent KeyPressed(msgMessage.wParam, iKeyCode, Selection, bCancel) 'If not handled, post back to the window using the original values If Not bCancel Then PostMessage lXLhwnd, iMessage, iKeyCode, 0 End If End If errHandler: 'Allow the processing of other msgs. DoEvents Loop Until bExitLoop End Sub Public Sub StopKeyPressWatch() 'Set this boolean flag to exit the above loop. bExitLoop = True End Sub 

Using

 Option Explicit Dim WithEvents CKeyWatcher As KeyPressApi Private Sub Worksheet_Activate() If CKeyWatcher Is Nothing Then Set CKeyWatcher = New KeyPressApi End If CKeyWatcher.StartKeyPressInit End Sub Private Sub Worksheet_Deactivate() CKeyWatcher.StopKeyPressWatch End Sub '\\This example illustrates how to catch worksheet '\\Key strokes in order to prevent entering numeric '\\characters in the Range "A1:D10" . Private Sub CKeyWatcher_KeyPressed(ByVal KeyAscii As Integer, _ ByVal KeyCode As Integer, _ ByVal Target As Range, _ Cancel As Boolean) Const MSG As String = _ "Numeric Characters are not allowed in" & _ vbNewLine & "the Range: """ Const TITLE As String = "Invalid Entry !" If Not Intersect(Target, Range("A1:D10")) Is Nothing Then If Chr(KeyAscii) Like "[0-9]" Then MsgBox MSG & Range("A1:D10").Address(False, False) _ & """ .", vbCritical, TITLE Cancel = True End If End If End Sub 

Answer 3

I had the same problem and solved it by placing a text box above the cell. I set the properties so that the text box looks like an Excel cell, and then used the Top and Left properties to put it in the cell using the same properties from the cell, and set the width and height as one of the cell. Then I made it visible. I used the KeyDown event to handle keystrokes. In my code, I positioned the list box below the cell to display the corresponding items from the list on another sheet. Note. This code was on the worksheet, the Cell variable was declared in the module: Global Cell as Range. This works much better than the combo box. tb1 is the text box, and lb1 is the list. You will need a sheet called Fruit with the data in the first column. The sheet on which this code works will only be executed if the selected cell is in column = 2 and is empty. Remember to declare the cell as described above.

 Option Explicit Private Sub lb1_Click() Cell.Value2 = lb1.Value tb1.Visible = False lb1.Visible = False Cell.Activate End Sub Private Sub tb1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) Dim Row As Long Dim Temp As String Select Case KeyCode Case vbKeyBack If Len(tb1.Value) > 0 Then tb1.Value = Left(tb1.Value, Len(tb1.Value) - 1) Case vbKeySpace, vbKeyA To vbKeyZ tb1.Value = WorksheetFunction.Proper(tb1.Value & Chr(KeyCode)) Case vbKeyReturn If lb1.ListCount > 0 Then Cell.Value2 = lb1.List(0) Else Cell.Value2 = tb1.Value With Sheets("Fruit") .Cells(.UsedRange.Rows.Count + 1, 1) = tb1.Value .UsedRange.Sort Key1:=.Cells(1, 1), Header:=xlYes End With MsgBox tb1.Value & " has been added to the List" End If tb1.Visible = False lb1.Visible = False Cell.Activate Case vbKeyEscape tb1.Visible = False lb1.Visible = False Cell.Activate End Select lb1.Clear Temp = LCase(tb1.Value) & "*" With Sheets("Fruit") For Row = 2 To .UsedRange.Rows.Count If LCase(.Cells(Row, 1)) Like Temp Then lb1.AddItem .Cells(Row, 1) End If Next Row End With KeyCode = 0 End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Column = 2 And Target.Cells.Count = 1 Then If Target.Value2 = Empty Then Set Cell = Target With Cell tb1.Top = .Top tb1.Left = .Left tb1.Height = .Height + 1 tb1.Width = .Width + 1 End With tb1.Value = Empty tb1.Visible = True tb1.Activate With Cell.Offset(1, 0) lb1.Top = .Top lb1.Left = .Left lb1.Width = .Width + 1 lb1.Clear lb1.Visible = True End With Else tb1.Visible = False lb1.Visible = False End If Else tb1.Visible = False lb1.Visible = False End If End Sub