Increment/decrement a number in a cell through keyboard shortcut

[roc_on_the_rocks]

I have a case where a cell value (e.g. cell C1) defines the row number that defines the row to be plotted. So when I need to check other nearby rows, I currently need to type row numbers Up and Down. My log files can contain five thousand rows making impractical to plot everything, so I am looking for a way to 'scan' areas in my data.

It would be great if someone could help me with a VBA script where I could increment/decrement the value in that cell, by a calibrateable values (e.g. 100), by using keyboard keys, like arrows Up/Down, +/-, keys U/D, or whatever is easier. Only one increment/decrement per key stroke. Perhaps continuous increments/decrements while the key is held, if that's not too difficult.

As always, big thanks to the Mr. Excel community.

 

[JamesW]

Hi,

Try this in a new module:

Sub capturekey()
    Application.OnKey "{UP}", "incUp"
    Application.OnKey "{DOWN}", "incDown"
End Sub

Sub incUp()
    If ActiveCell.Address = "$C$1" Then
        cVal = Range("A1").Value
        Range("C1").Value = Range("C1").Value + cVal
    End If
End Sub

Sub incDown()
    If ActiveCell.Address = "$C$1" Then
        cVal = Range("A1").Value
        Range("C1").Value = Range("C1").Value - cVal
    End If
End Sub

Where A1 is your valure you want to increase by, and C1 is your value.

 

[mikerickson]

You could put this in a normal module

Sub IncrimentActiveCell()
    With ActiveCell
        .Value = Val(CStr(.Value)) + 1
    End With
End Sub

Sub DecrimentActiveCell()
    With ActiveCell
        .Value = Val(CStr(.Value)) - 1
    End With
End Sub

and this in the ThisWorkbook code module

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Excel.Range)
    If Target.Address(, , , True) = ThisWorkbook.Sheets("Sheet1").Range("C1").Address(, , , True) Then
        Call ActivateKeys
    Else
        Call unActivateKeys
    End If
End Sub

Private Sub Workbook_Activate()
    If ActiveCell.Address(, , , True) = ThisWorkbook.Sheets("Sheet1").Range("C1").Address(, , , True) Then
        ActiveCell.Offset(1, 0).Select
    End If
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If ActiveCell.Address(, , , True) = ThisWorkbook.Sheets("Sheet1").Range("C1").Address(, , , True) Then
        ActiveCell.Offset(1, 0).Select
    Else
        Call unActivateKeys
    End If
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call unActivateKeys
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Call unActivateKeys
End Sub

Private Sub Workbook_Deactivate()
    Call unActivateKeys
End Sub

Sub ActivateKeys()
    With Application
        .OnKey "{up}", "IncrimentActiveCell"
        .OnKey "{down}", "DecrimentActiveCell"
    End With
End Sub

Sub unActivateKeys()
    With Application
        .OnKey "{up}"
        .OnKey "{down}"
    End With
End Sub

 

[roc_on_the_rocks]

JamesW,

Outstanding! It works like a charm.

How can I add this to a given workbook (not Personal.xlsb), having it 'running' while this workbook is open?

 

[leecavturbo]

how do you apply this to all cells rather than just C1