Change value of cell based on input value-CodePudding

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("d10:e309")) Is Nothing Then
        On Error GoTo bm_Safe_Exit
        Application.EnableEvents = False
        With Range("d10:e309")
            Select Case .Value2
                Case 0
                    'do nothing
                Case 1
                    .Value = 0.01
                Case 5
                    .Value = 0.005
            End Select
        End With
    End If

bm_Safe_Exit:
        Application.EnableEvents = True
End Sub

I'm wanting the code to use 1 and 5 when inputted into a cell to act as shortcuts to automatically be replaced in the cell inputted in with .01 and .005 respectively

CodePudding user response：

Range("d10:e309").Value2 will be an array. Comparing an array to a value doesn't work. Secondly Target.Value may be an array too, if more than one cell is changed, eg by copy paste. It also may include cells outside your range of interest

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim TargetRange As Range, rng As Range 
    Set TargetRange = Intersect(Target, Range("d10:e309"))
    If Not TargetRange Is Nothing Then
        On Error GoTo bm_Safe_Exit
        Application.EnableEvents = False
        For Each rng In TargetRange 
            Select Case rng.Value2
                Case 0
                    'do nothing
                Case 1
                    Rng.Value = 0.01
                Case 5
                    Rng.Value = 0.005
            End Select
        Next
    End If

bm_Safe_Exit:
    Application.EnableEvents = True
End Sub