Clicking a cell to change/cycle through values

bparson017

New Member
Joined
Aug 20, 2017
Messages
5
Hello everyone,

(First time poster here)

I am an educator and I would like to create a VBA script to help me with a specific type of grading I would like to perform in Excel. I would like to be able to click a cell that changes the value of that cell. For example:
Assume cell C2 through C70 represent the fields to be filled. Upon the first click in a given cell, I want the cell to show the value "4", the second click to be "3", the third to be "2.5", the fourth to be "2", then "1.5", then "1", etc. to 0. If it is 0, then I would like it to return to 4. I would like this to apply for all cells C2:C70, D2:D70, E2:E70, etc. for about 10 columns or so.

Any help on this matter would be greatly appreciated! Thank you to the MrExcel community here :D
 

Excel Facts

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.
Welcome to the MrExcel board!

If you want to do this with a single click (ie selecting the cell) then you could try the first code below.
Note, however, that if you want to change the same cell twice in a row, you would need to select it once to make the first change then select some other cell then re-select the cell in question.

Another option would be to trigger the process with a double-click. this would mean you could immediately change a cell's value twice, simply by double-clicking it twice. The second code should do that for you.

To implement either code (don't leave both codes active at the same time) ..
1. Right click the sheet name tab and choose "View Code".
2. Copy and Paste the code below into the main right hand pane that opens at step 1.
3. Close the Visual Basic window & test.
4. Your workbook will need to be saved as a macro-enabled workbook (*.xlsm).

Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim myTarget As Range
  Dim NewVal As Single

  Set myTarget = Range("C2:L70")
  If Selection.Cells.Count = 1 Then
    If Not Intersect(Target, myTarget) Is Nothing Then
      Select Case Target.Value
        Case 0: NewVal = 4
        Case 4: NewVal = 3
        Case 3, 2.5, 2, 1.5, 1, 0.5: NewVal = Target.Value - 0.5
        Case Else: NewVal = Target.Value
      End Select
      Target.Value = NewVal
    End If
  End If
End Sub

Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Dim myTarget As Range
  Dim NewVal As Single
  
  Set myTarget = Range("C2:L70")
  If Not Intersect(Target, myTarget) Is Nothing Then
    Cancel = True
    Select Case Target.Value
      Case 0: NewVal = 4
      Case 4: NewVal = 3
      Case 3, 2.5, 2, 1.5, 1, 0.5: NewVal = Target.Value - 0.5
      Case Else: NewVal = Target.Value
    End Select
    Target.Value = NewVal
  End If
End Sub
 
Last edited:
Upvote 0
Welcome to the MrExcel board!

If you want to do this with a single click (ie selecting the cell) then you could try the first code below.
Note, however, that if you want to change the same cell twice in a row, you would need to select it once to make the first change then select some other cell then re-select the cell in question.

Another option would be to trigger the process with a double-click. this would mean you could immediately change a cell's value twice, simply by double-clicking it twice. The second code should do that for you.

To implement either code (don't leave both codes active at the same time) ..
1. Right click the sheet name tab and choose "View Code".
2. Copy and Paste the code below into the main right hand pane that opens at step 1.
3. Close the Visual Basic window & test.
4. Your workbook will need to be saved as a macro-enabled workbook (*.xlsm).

Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim myTarget As Range
  Dim NewVal As Single

  Set myTarget = Range("C2:L70")
  If Selection.Cells.Count = 1 Then
    If Not Intersect(Target, myTarget) Is Nothing Then
      Select Case Target.Value
        Case 0: NewVal = 4
        Case 4: NewVal = 3
        Case 3, 2.5, 2, 1.5, 1, 0.5: NewVal = Target.Value - 0.5
        Case Else: NewVal = Target.Value
      End Select
      Target.Value = NewVal
    End If
  End If
End Sub

Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Dim myTarget As Range
  Dim NewVal As Single
  
  Set myTarget = Range("C2:L70")
  If Not Intersect(Target, myTarget) Is Nothing Then
    Cancel = True
    Select Case Target.Value
      Case 0: NewVal = 4
      Case 4: NewVal = 3
      Case 3, 2.5, 2, 1.5, 1, 0.5: NewVal = Target.Value - 0.5
      Case Else: NewVal = Target.Value
    End Select
    Target.Value = NewVal
  End If
End Sub


Thank you for everything Peter_SSs! This is absolutely incredible! I could not have asked for anything more perfectly addressing what I want than the scripts you have provided! Thank you for your time and contribution! I am extremely grateful and could not be happier with the result! Ultimately, I can foresee myself using the double click option more often as it is the most convenient, especially on the tablet I will be using for teaching/grading!
 
Upvote 0
You are very welcome. :)

BTW, best not to quote whole long posts as it makes the post and thread harder to read/navigate. Just quote any specific parts that you want to comment on, or just enough so we know who you are responding to, if required.
 
Upvote 0
I'll do my best not to reply via quote unless I would like to highlight a specific part of the response :) Sorry for including such a long segment of your post in my reply. I'll work on that. Thank you again for providing the script so quickly! I am extremely appreciative! I have already added it to my Excel spreadsheet containing my classes' information. It works perfectly given my grading scale! Thank you!
 
Upvote 0
To implement either code (don't leave both codes active at the same time) ..
1. Right click the sheet name tab and choose "View Code".
2. Copy and Paste the code below into the main right hand pane that opens at step 1.
3. Close the Visual Basic window & test.
4. Your workbook will need to be saved as a macro-enabled workbook (*.xlsm).

Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim myTarget As Range
  Dim NewVal As Single

  Set myTarget = Range("C2:L70")
  If Selection.Cells.Count = 1 Then
    If Not Intersect(Target, myTarget) Is Nothing Then
      Select Case Target.Value
        Case 0: NewVal = 4
        Case 4: NewVal = 3
        Case 3, 2.5, 2, 1.5, 1, 0.5: NewVal = Target.Value - 0.5
        Case Else: NewVal = Target.Value
      End Select
      Target.Value = NewVal
    End If
  End If
End Sub

Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Dim myTarget As Range
  Dim NewVal As Single
 
  Set myTarget = Range("C2:L70")
  If Not Intersect(Target, myTarget) Is Nothing Then
    Cancel = True
    Select Case Target.Value
      Case 0: NewVal = 4
      Case 4: NewVal = 3
      Case 3, 2.5, 2, 1.5, 1, 0.5: NewVal = Target.Value - 0.5
      Case Else: NewVal = Target.Value
    End Select
    Target.Value = NewVal
  End If
End Sub
I'm trying to do something similar to what the original poster is. I changed the cells to the ones applicable to my use, but it doesn't work. I'm in Office 365 and want to set up a handful of cells to click-toggle between a number of different options for use by my team for easy tracking of a number of status possibilities.

Should this work just the same in 365 or do I need to modify something? Thank you.
 
Upvote 0
Sorry. Total newbie mistake. I still had Developer Mode turned on. The code DOES work in 365 if you're not in Developer Mode 🤦‍♂️
 
Upvote 0

Forum statistics

Threads
1,223,907
Messages
6,175,300
Members
452,633
Latest member
DougMo

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top