EXCEL - Tally Routine needed 1

[BobJacksonNCI]

Merry Christmas to all of the helpful folks who contribute to the usefulness of this site!

I want to react to a keystroke in a specific cell and
add to a counter in another cell based on the
keystroke entered.
For example:
A1 = the target cell.

If 1 is typed, add 1 to C1
If 2 is typed, add 1 to D1
etc

Freeze selection to A1 so I can zip through a bunch of response cards without lifting my right hand from the number pad.

Would someone help, please?
Bob

 

[GVF]

Bob,
Here is a snippet using an "OnEntry" routine. If you insist on using Row 1 you will have to set the "Move on entry" option to false. If you can use row 2 then you can leave the "Move On Entry" option alone and remove the apostrophe from the "Cells(1, 1).Select" line. I don't think you can use "OnKey" with the numeric keypad.

Public EntryDirection As XlDirection
Public EnterMove As Boolean

Sub SetTheOnEnterRoutine()
On Error Resume Next
EnterMove = Application.MoveAfterReturn
EntryDirection = Application.MoveAfterReturnDirection
Sheets(ActiveSheet.Name).OnEntry = "myOnEnter"
Application.MoveAfterReturn = False
End Sub

Sub ReSetOnEnter()
On Error Resume Next
Application.MoveAfterReturn = EnterMove
Application.MoveAfterReturnDirection = EntryDirection
Sheets(ActiveSheet.Name).OnEntry = ""
End Sub

Sub MyOnEnter()
On Error Resume Next
If ActiveCell.Row = 1 And ActiveCell.Column = 1 Then
If IsNumeric(Cells(1, 1).Value) And Cells(1, 1).Value <> "" Then
Cells(1, ActiveCell.Value + 2).Value = Cells(1, ActiveCell.Value + 2).Value + 1
End If
'Cells(1, 1).select
End If
End Sub

Greg

 

[SkipVought]

Hi,

Copy this code to the WORKSHEET OBJECT CODE SHEET. (right-click the sheet tab - select View Code)

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
   With Target
      If .Address <> [A1].Address Then Exit Sub
      Select Case .Value
         Case 1
            With [C1]
               .Value = .Value + 1
            End With
         Case 2
            With [D1]
               .Value = .Value + 1
            End With
      End Select
   End With
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
   With Target
      If .Address <> [A2].Address And .Address <> [B1].Address Then Exit Sub
      .Offset(-1).Select
   End With
End Sub

Skip,

_{[red]Be Advised![/red]
The band of elderly oriental musicians, known as Ground Cover, is, in reality...
Asian Jasmine!}

 

[BobJacksonNCI]

GVF,

Thanks for taking your time to assist!

Skip,

Your assistance is going to save my staff a Great Deal of time. A star for your timely and "on the money" reply.

Hope you have a terrific day tomorrow!
Bob