SOLVED

VBA code to toggle cell value

Iron Contributor

Hi
I need VBA code for excel 365 to toggle the cell value (which is less than 50 only) to 50 by clicking on cell. for example:
In the attached file, the yellow range in sheet 2
if I click on E7 the cell value change from 22 to 50 and when clicking again changes its value to 22.
if I click on E9 the cell value change is not changed because it is >50.

I need VBA to apply on the yellow range of sheet 2 of the attached file.
Thx.

1 Reply
best response confirmed by ajl_ahmed (Iron Contributor)
Solution

@ajl_ahmed 

I'd do this (if I wanted to do this at all) on double-clicking the cell, because the event that reacts to clicking on a cell also reacts to using the arrow keys to select a cell.

In the worksheet module of Sheet2:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim adr As String
    If Not Intersect(Range("B7:E14"), Target) Is Nothing Then
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        Cancel = True
        If Target.HasFormula Then
            If Target.Value < 50 Then
                Target.Value = 50
            End If
        Else
            adr = Target.Offset(1, 3).Address(False, False)
            Target.Formula = "=IF(Sheet1!" & adr & "="""","""",Sheet1!" & adr & ")"
        End If
        Application.EnableEvents = True
        Application.ScreenUpdating = True
    End If
End Sub

See the attached version (now a macro-enabled workbook).

1 best response

Accepted Solutions
best response confirmed by ajl_ahmed (Iron Contributor)
Solution

@ajl_ahmed 

I'd do this (if I wanted to do this at all) on double-clicking the cell, because the event that reacts to clicking on a cell also reacts to using the arrow keys to select a cell.

In the worksheet module of Sheet2:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim adr As String
    If Not Intersect(Range("B7:E14"), Target) Is Nothing Then
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        Cancel = True
        If Target.HasFormula Then
            If Target.Value < 50 Then
                Target.Value = 50
            End If
        Else
            adr = Target.Offset(1, 3).Address(False, False)
            Target.Formula = "=IF(Sheet1!" & adr & "="""","""",Sheet1!" & adr & ")"
        End If
        Application.EnableEvents = True
        Application.ScreenUpdating = True
    End If
End Sub

See the attached version (now a macro-enabled workbook).

View solution in original post