Clicking a cell to change/cycle through values

[bparson017]

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

 

[Peter_SSs]

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).

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

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

 

[bparson017]

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).

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

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!

 

[Peter_SSs]

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.

 

[bparson017]

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!