Sheet not protecting

BlokeMan

Board Regular
Joined
Aug 9, 2011
Messages
125
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

Code:
' 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




 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.

ZVI

MrExcel MVP
Joined
Apr 9, 2008
Messages
3,818
Office Version
  1. 2016
  2. 2010
  3. 2007
Platform
  1. Windows
Just replace this line: Sheets("Shift 1").Unprotect Password:="xxx" by that one: Sheets("Shift 1").Protect Password:="xxx", UserInterfaceOnly:=True
 

ZVI

MrExcel MVP
Joined
Apr 9, 2008
Messages
3,818
Office Version
  1. 2016
  2. 2010
  3. 2007
Platform
  1. Windows
*** deleted because of TAGs issue ***
 
Last edited:

Watch MrExcel Video

Forum statistics

Threads
1,130,335
Messages
5,641,555
Members
417,220
Latest member
lam150498

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top