ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Macro (https://www.excelbanter.com/excel-programming/386413-macro.html)

[email protected]

Macro
 
I am trying to create a macro-and I am new at this so bare with me-
where if I am within a cell by simply pushing the up or down arrow the
value within the cell will increase or decrease with each key stroke.
Can this be done.


JE McGimpsey

Macro
 
If by "within a cell" you mean in Edit Mode, then no - macros are
disabled in Edit mode.

If you want this to happen in one particular cell, this may work for you:

Put this in the worksheet code module:

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Application.OnKey "{UP}"
Application.OnKey "{DOWN}"
With Target
If .Count = 1 Then
If Not Intersect(.Cells, Range("J5")) Is Nothing Then
Application.OnKey "{UP}", "AddOne"
Application.OnKey "{DOWN}", "SubtractOne"
End If
End If
End With
End Sub

(change J5 to suit). Put these in a regular code module:

Public Sub AddOne()
With ActiveCell
If IsNumeric(.Value) Then .Value = .Value + 1
End With
End Sub

Public Sub SubtractOne()
With ActiveCell
If IsNumeric(.Value) Then .Value = .Value - 1
End With
End Sub



In article .com,
wrote:

I am trying to create a macro-and I am new at this so bare with me-
where if I am within a cell by simply pushing the up or down arrow the
value within the cell will increase or decrease with each key stroke.
Can this be done.


Greg Wilson

Macro
 
Run the first macro to add a button to the Worksheet Menu Bar that toggles
the behavior of the arrow keys. This button will be temporary and so will
automatically delete upon closing Excel. After adding the button click it and
then test the arrow keys. Click it again to reset to normal.

Sub AddBtn()
With Application.CommandBars(1)
With .Controls.Add(Temporary:=True)
.OnAction = "TogArrowKeys"
.FaceId = 468
End With
End With
End Sub

Sub TogArrowKeys()
Dim btn As CommandBarButton
With Application
Set btn = .CommandBars.ActionControl
If btn.State = msoButtonUp Then
.OnKey "{UP}", "IncrementCell"
.OnKey "{DOWN}", "DecrementCell"
btn.State = msoButtonDown
Else
.OnKey "{UP}"
.OnKey "{DOWN}"
btn.State = msoButtonUp
End If
End With
End Sub

Sub IncrementCell()
With ActiveCell
If Not IsNumeric(.Value) Then Exit Sub
.Value = .Value + 1
End With
On Error GoTo 0
End Sub

Sub DecrementCell()
With ActiveCell
If Not IsNumeric(.Value) Then Exit Sub
.Value = .Value - 1
End With
End Sub

Regards,
Greg



Greg Wilson

Macro
 
You can remove the "On Error GoTo 0" line in the IncrementCell macro. A
leftover when I changed my mind on how to deal with the potential of text in
the cells.

Greg

"Greg Wilson" wrote:

Run the first macro to add a button to the Worksheet Menu Bar that toggles
the behavior of the arrow keys. This button will be temporary and so will
automatically delete upon closing Excel. After adding the button click it and
then test the arrow keys. Click it again to reset to normal.

Sub AddBtn()
With Application.CommandBars(1)
With .Controls.Add(Temporary:=True)
.OnAction = "TogArrowKeys"
.FaceId = 468
End With
End With
End Sub

Sub TogArrowKeys()
Dim btn As CommandBarButton
With Application
Set btn = .CommandBars.ActionControl
If btn.State = msoButtonUp Then
.OnKey "{UP}", "IncrementCell"
.OnKey "{DOWN}", "DecrementCell"
btn.State = msoButtonDown
Else
.OnKey "{UP}"
.OnKey "{DOWN}"
btn.State = msoButtonUp
End If
End With
End Sub

Sub IncrementCell()
With ActiveCell
If Not IsNumeric(.Value) Then Exit Sub
.Value = .Value + 1
End With
On Error GoTo 0
End Sub

Sub DecrementCell()
With ActiveCell
If Not IsNumeric(.Value) Then Exit Sub
.Value = .Value - 1
End With
End Sub

Regards,
Greg




All times are GMT +1. The time now is 06:30 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com