I have something like this

What I want to do is:

If B1 = “Y” then let the user enter a number in B2. If B1 = “N”, change the value in B2 to zero and don’t allow the user to enter any number in B2 unless the user changes the value of B1 back to “Y”. Basically, the user is allowed to enter a number in B2 if and only if the B1=”Y”.

What I did so far:

1. Data -> Data Validation -> Custom and here's the formula I've written

=OR(AND(B1="Y",ISNUMBER(B2)),AND(B1="N",B2=0))

This solution is not ideal b/c it does not change B2 to zero when the B1 is selected as N. Also when B1 is changed to Y, it doesn't force user to enter a new value in B2.

2. I have tried to solve the problem using VBA. This is the code that I have written

ActiveSheet.Unprotect
Range("B2").Locked = False
If Target.Address = "$B$1" Then
    Dim myValue As Variant
    If Range("B1").Value = "N" Then
        Range("B2").Value = 0
    Else
        myValue = InputBox("Give me some input")
        Range("B2").Value = myValue
    
    End If
    
End If
Range("B2").Locked = True
ActiveSheet.Protect
End Sub

This solution works fine except that I got an error when the code tries to lock B2 again to prevent users from entering numbers directly into the B2 cell (not using Inputbox). Also, I need to add some code to restrict data entry to just numbers.

Error when changing the B1

Any idea how I can tackle this?

PS: I managed to resolve the above code with the help of SJR

Private Sub Worksheet_Change(ByVal Target As Range)

Worksheets("Sheet1").Unprotect

If Target.Address = "$B$1" Then
    Dim myValue As Variant
    If Range("B1").Value = "N" Then
        Range("B2").Value = 0
    Else
    myValue = "no"
        Do Until IsNumeric(myValue)
                myValue = InputBox("Enter a number > 0")
        Loop
        Range("B2").Value = myValue
    End If
    
End If
Worksheets("Sheet1").Protect
End Sub

CodePudding user response：

Working with styles could help here.

Create a style called "InputData", set locked to false (on the protected tab (?)) and propably the filling to e.g. yellow to distinguish input-cells from the rest.

Assign this style to B2

Add a worksheet-name for B2 "Question" and for B3 "Answer".

Paste the following code into the sheets module:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If hasName(Target.Cells(1, 1)) Then
    If Target.Cells(1, 1).Name.Name Like "*Question*" Then
       lockUnlockAnswer
    End If
End If
End Sub


Private Sub lockUnlockAnswer()

Me.Unprotect

Application.EnableEvents = False

If Me.Range("Question") = "Y" Then
    With Me.Range("Answer")
        .Style = "InputData"  'this style
        .Value = vbNullString
    End With
Else
    With Me.Range("Answer")
        .Style = "Normal"
        .Value = 0
    End With
End If
    
Application.EnableEvents = True
    
Me.Protect
End Sub


Public Function hasName(ByVal c As Range) As Boolean
On Error Resume Next
hasName = CBool(c.Name.Name <> vbNullString)
If Err = 0 Then hasName = True
Err.Clear
On Error GoTo 0
End Function

Whenever user changes anything on the sheet the on_change-event fires.

If the change happened in "Question" lockUnlockAnswer is called.

If Question = "Y" then Style "InputData" is applied to B3 (= Answer). The cell is editable!

If Question <> "Y" then Style "Normal" is applied to B3. The cell is locked and set to 0.

To prevent that worksheet_change is called again, EnableEvents is set to false.

(Presumably you will have more questions/answers that should work like this - you can simply add an index to the cell-names. Add a parameter "index" to lockUnlockAnswer and add the index the range-names ... then the routine will work for different question/answer ranges)