Lock a cell in a column when a user types "-" character

[Shirin301]

Dear Excel gurus,

I am new to VBA, and I would like to write such a code that when a user types "-" sign in the cells in the Column number 11 (K2:K100), the only current cell can be locked automatically, not all cells below the current one. The other cells can be locked after the "-" sign is entered again. I written down the code below so that you can help me. I searched a lot on internet but could not find the exact solution to my problem. I appreciate any help in advance.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Value = "-" Then
Dim Source As String
Source = "Do you want to unlock the password"
changeInput = MsgBox(Source, vbYesNo + vbQuestion, "Unlock the sheet")
If changeInput = vbYes Then
Dim pass As String
pass = InputBox("Enter the password")
If pass <> "test" Then
MsgBox ("Wrong Password")
Else
ActiveSheet.Unprotect Password:="test"
Target.Locked = False
End If
End If
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cel As Range
ActiveSheet.Unprotect Password:="test"
Set cel = ActiveSheet.Range("K2:K100")

If cel = "-" Then
check = MsgBox("The cell will be locked after "-" sign.", vbYesNo, "Warning")
If check = vbYes Then
cel.Locked = True
Else
cel.Value = ""
End If
End If
'ActiveSheet.Protect Password:="test"
End Sub

 

[Yongle]

Try this combination
- note variable & constant declared at TOP of code to make available to all procedures in sheet code

Place in sheet code window

Option Explicit
Private Const pw = "test"
Private T As Range

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim msg As String: msg = "The cell will be locked after  " & Chr(34) & " - " & Chr(34) & " sign"
    If Not Intersect(Target, Range("K2").Resize(Me.Rows.Count - 1)) Is Nothing Then
        Set T = Target.Resize(1, 1)
        If T = "-" Then
            Select Case MsgBox(msg, vbYesNo, "Warning!")
                Case vbYes
                    Me.Unprotect pw
                    T.Locked = True
                    Me.Protect pw
                Case Else: Target.ClearContents
            End Select
        End If
    End If
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Const source = "Do you want to unlock cell with password"
    Const wrong = "wrong password"
    Set T = Target.Resize(1, 1)
    If Not Intersect(Target, Range("K2").Resize(Me.Rows.Count - 1)) Is Nothing Then
        If T = "-" Then
            If MsgBox(source, vbYesNo + vbQuestion, "Unlock the cell?") = vbYes Then
                Select Case InputBox("Enter the password")
                    Case pw
                        Me.Unprotect pw
                        T.Locked = False
                        T.ClearContents
                        Me.Protect pw
                    Case Else: MsgBox wrong
                End Select
            End If
        End If
    End If
End Sub

 

[Shirin301]

Thanks for your prompt response, but interestingly, when I put "-" sign in that column, all cells will get locked. I want to lock seperately each cell by entering minus sign.

 

[Yongle]

Try this minor amendment

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim msg As String: msg = "The cell will be locked after  " & Chr(34) & " - " & Chr(34) & " sign"
    Set T = Target.Resize(1, 1)
    If Not Intersect(Target, Range("K2").Resize(Me.Rows.Count - 1)) Is Nothing Then
        If T = "-" Then
            Select Case MsgBox(msg, vbYesNo, "Warning!")
                Case vbYes
                    Me.Unprotect pw
                    T.Locked = True
                    Me.Protect pw
                Case Else: Target.ClearContents
            End Select
        End If
    End If
End Sub

 

[Shirin301]

Interestingly, the cells until 6th cell are unlocked. Is it supposed to include a range of K2:K1,048,576 ? My starting cell is K2.

 

[Shirin301]

not unlocked sorry locked*

 

[Yongle]

not unlocked sorry locked*

That is a garbled message!
- no idea what you are saying


Before any further testing manually unlock all cells in column K and then re-edit each cell
- it works for me and only locks ONE cell
- I suspect any problem was left behind by the first test