Let's start with this code, which I will explain below.
Open the VB Editor Alt+F11. Right click the sheet that you want this behavior to occur on and select View Code.
Copy and paste the following code into the worksheet code.
Private Sub Worksheet_Change(ByVal Target As Range)
'CountLarge is an Excel 2007+ property, if using Excel 2003
'change to just Count
If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub
If Target.Address = "$A$1" Then
If Target.Value = 0 Then
Me.Range("H32").FormulaR1C1 = "=SUM(R[-4]C:R[-2]C)"
ElseIf Target.Value = 1 Then
Me.Range("B15").FormulaR1C1 = "=SUM(R[-1]C:R[-1]C)"
End If
End If
End Sub
The Worksheet_Change event is fired every time a user makes a change to the worksheet. If you change a cell value, for example, this event is triggered.
The first line within this subroutine checks to ensure that multiple cells weren't changed and that there was in fact an actual cell change, if either is not true then it will not continue.
Then we check to ensure that the value change happened in cell A1, if it did, we enter that IF statement.
From there, we check the value that was entered into cell A1. If the value was 0, the appropriate formula is added to H32. If the value was 1, the appropriate formula is added to B15. If a value other than 0 or 1 is entered into cell A1, nothing happens.
It is important to note that you must leave the cell for this event to trigger, so while this is a good start, I don't currently know of a way to get this event to fire without at least pressing enter or leaving the cell.
Update
After a bit of research and playing around, I've figured out how you can make this change without pressing enter or any other button, this will occur immediately after either '0' or '1' is pressed, even if you are editing the cell value. I used a keyboard handler from this previous SO question.
The code between the BEGIN KEYBOARD HANDLING and END KEYBOARD HANDLING event was from above.
Copy and paste the following code into the worksheet code of whichever sheet you want to capture these key strokes on:
Option Explicit
'BEGIN KEYBOARD HANDLING
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 StartKeyWatch()
Dim msgMessage As MSG
Dim bCancel As Boolean
Dim iKeyCode As Integer
Dim lXLhwnd As Long
'handle the ESC key.
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
Private Sub Worksheet_Activate()
Me.StartKeyWatch
End Sub
Private Sub Worksheet_Deactivate()
Me.StopKeyWatch
End Sub
'End Keyboard Handling
Private Sub Sheet_KeyPress(ByVal KeyAscii As Integer, ByVal KeyCode As Integer, ByVal Target As Range, Cancel As Boolean)
'CountLarge is an Excel 2007+ property, if using Excel 2003
'change to just Count
If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub
If Target.Address = "$A$1" Then
If KeyAscii = 48 Then
Me.Range("H32").FormulaR1C1 = "=SUM(R[-4]C:R[-2]C)"
ElseIf KeyAscii = 49 Then
Me.Range("B15").FormulaR1C1 = "=SUM(R[-1]C:R[-1]C)"
End If
End If
End Sub
Additionally, right click on the ThisWorkbook object --> View Code, and add this code in:
Private Sub Workbook_Open()
Sheets("Sheet1").StartKeyWatch
End Sub
Be sure to change Sheet1 to whatever the name of your worksheet is.
The VBA will 'listen' for key presses and if the active cell is A1 and either a 0 or 1 is entered, the appropriate action will be performed even before the user does anything else.
I will add that his comes at a slight performance cost, as the code that executes on Workbook_Open takes a couple seconds to run.
Thanks to user Siddharth Rout for pointing out the potential issue with Count from Excel 2007 and on and directing me to use CountLarge instead.
