Sheet not protecting

[BlokeMan]

Hi,

The macro below will insert a comment through pop-up box, the problem is when you click OK without entering any comments or click cancel it will not protect the sheet. Can someone please fix the macro, still learning to code.

Thanks

' Double-click on a cell, a pop-up box will appear allowing the user to add a comment to the cell.' This new comment would be added to whatever comments were already in that cell.
' In addition, the date, time, Excel registration name, etc. are all appended to the new comment.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)


    On Error Resume Next
    Dim cmtText As String
    Dim strCommentName As String
    Dim inputText As String
    Const maxLineLength As Long = 65
    
    Sheets("Shift 1").Unprotect Password:="xxx"
    Set Target = Target.Cells(1, 1)
    If Target.Comment Is Nothing Then
        cmtText = InputBox("Please enter Comment:", "Comment Text")
        If cmtText = "" Then Exit Sub
        cmtText = Now & "-" & Application.UserName & "-" & cmtText
        cmtText = Word_Wrap(cmtText, maxLineLength)
        
        strCommentName = cmtText & vbLf & Now
        
        Target.AddComment text:=cmtText
        'Target.Comment.Visible = True
        Target.Comment.Shape.TextFrame.AutoSize = True
    Else
        If Target.Comment.text <> "" Then
            
            inputText = InputBox("Please enter Comment:", "Comment Text")
            If inputText = "" Then Exit Sub
            inputText = Now & "-" & Application.UserName & "-" & inputText
            inputText = Word_Wrap(inputText, maxLineLength)
            cmtText = Target.Comment.text & Chr(10) & inputText
        Else
            cmtText = InputBox("Please enter Comment:", "Comment Text")
        End If
        Target.ClearComments
        cmtText = cmtText
        Target.AddComment text:=cmtText
        ' Target.Comment.Visible = True
        Target.Comment.Shape.Width = 300
        Target.Comment.Shape.Height = 100
        
    End If
    Sheets("Shift 1").Protect Password:="xxx"
    Cancel = True
    
End Sub

Function Word_Wrap(text As String, maxLineLength As Integer) As String


Dim words() As String
Dim line As String
Dim word As Variant


Word_Wrap = ""


words = Split(text, " ")
line = ""


For Each word In words
    If Len(line & word) > maxLineLength Then
        If Word_Wrap = "" Then
            Word_Wrap = line
        Else
            Word_Wrap = Word_Wrap & vbLf & line
        End If
        line = word
    Else
        If line = "" Then
            line = word
        Else
            line = line & " " & word
        End If
    End If
Next


If line <> "" Then
    If Word_Wrap = "" Then
        Word_Wrap = line
    Else
        Word_Wrap = Word_Wrap & vbLf & line
    End If
End If


End Function

 

[ZVI]

Just replace this line: Sheets("Shift 1").Unprotect Password:="xxx" by that one: Sheets("Shift 1").Protect Password:="xxx", UserInterfaceOnly:=True

 

[ZVI]

*** deleted because of TAGs issue ***