1

I have a vba script i am working on. It applies a time stamp each time the relevant cell is double clicked. Once its double clicked the cells are locked.

When the cell is double clicked on again a pop up box appears requesting a password, which is fine.

Problem: However i want the cell to be left unprotected until it gets double clicked again. 

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

With Target
    If .Column = 4 Then
        Select Case .Row
            Case 20, 24, 25, 27, 28, 30 - 35, 37, 38, 40, 42 - 44, 54 - 56, 58, 59, 61 - 65
               ActiveSheet.Protect Password:="Test", userinterfaceonly:=True
                .Value2 = "Prepared By" & "  " & Environ("Username")
                .Value2 = .Value2 & "  " & Format(Now, "yyyy-MM-dd hh:mm:ss")
                .Locked = True
                ActiveSheet.Unprotect
        End Select
    End If
End With

Edited as per below answer , however user is able double click the protect cell which still changes regards password is entered or not. 

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    Application.EnableEvents = False

    With Target
        If .Column = 4 Then
            Select Case .Row
                Case 20, 24, 25, 27, 28, 30, 31, 32, 33, 34, 35, 37, 38, 40, 42, 43, 44, 54, 55, 56, 58, 59, 61, 62, 63, 64, 65
                    If InStr(1, Target.Value2, "@@") = 0 Then
                        Target.Value2 = Target.Value2 & "@@"
                    Else
                        ActiveSheet.Protect Password:="Test", userinterfaceonly:=True
                        .Value2 = "Prepared By" & "  " & Environ("Username")
                        .Value2 = .Value2 & "  " & Format(Now, "yyyy-MM-dd hh:mm:ss")
                        .Locked = True
                        ActiveSheet.Unprotect
                    End If
            End Select
        End If
    End With
Community
  • 1
  • 1
James
  • 481
  • 3
  • 11
  • 32
  • *i want the cell to be left unprotected until it gets double clicked again* upon opening workbook again? Or you need to protect cell on second event? – AntiDrondert Sep 28 '17 at 06:39
  • @Antidrondert protect cell until second event. So when it gets double clicked again protect cell – James Sep 28 '17 at 06:59
  • The most basic solution I have in mind is to check for some special symbol/combination of symbols which you will add at the end of the cell on a first event and replace it with `""` on second event. For example `If InStr(1, Target.Value2, "@@") = 0 Then Target.Value2 = Target.Value2 & "@@" Else Protect yaddayadda EndIf`. Though I might be wrong if this cell's value is used in formulas or other procedures/functions, for example. – AntiDrondert Sep 28 '17 at 07:03
  • How would I built that into my current code? – James Sep 28 '17 at 07:07
  • `If InStr(1, Target.Value2, "@@") = 0 Then` before `ActiveSheet.Protect`, followed by `Target.Value2 = Target.Value2 & "@@"` with `Else` right after this line, ending with `EndIf` after `ActiveSheet.Unprotect` – AntiDrondert Sep 28 '17 at 07:10
  • @AntiDrondert have put my edits in the question. – James Sep 28 '17 at 07:39

0 Answers0