VBA Code Creates Comments with Username and date/timestamp - Need permanent entries

[Kellie220]

** The Below code I found here, user name Hask123, not my code.** Hask123 found a similar code online and manipulated it to their needs. This seems to be what I need as well, and I need to manipulate it to my needs. I do not have a range but a coulmn I need to use it in. This would be Column A cell 2 through cell 9999 (the whole column A excluding my header). I also need what is put into the cell once it is date/user stamped to not be over road when adding a new comment to the cell. Keep the string of successive comments but make them permanent within the cell. Any suggestion on that? This is for tracking comments on each row of data. We need to track the history of what happens to the data in each row over time (Comment section). We do not want to lose visibility of the previous comments, yet we need to add new comments. Any suggestions? Is this doable?

Code:

Private Sub Worksheet_Change(ByVal Target As Range)



Dim MyTargetRange As Range

Set MyTargetRange = ActiveSheet.Range("E17:E65")



If Not Intersect(Target, Range("E17:E65")) Is Nothing Then 'Change this range as appropriate.

If Target.Cells.Count = 1 Then

If Len(Target.Formula) > 0 Then



'If comment already exists, add a carriage return, username and timestamp to the current comment value.

If Not Target.Comment Is Nothing Then



With Target.Comment

MyString = Environ("USERNAME") & " " & Format(Now(), "ddd dd mmm yy hh:mm")

.Text Text:=Target.Comment.Text & Chr(10) & Environ("USERNAME") & " " & Format(Now(), "ddd dd-mmm-yy hh:mm")



With .Shape.TextFrame

.Characters(1, .Characters.Count).Font.Bold = False 'make the whole comment non-bold

'.Characters(InStrRev(Target.Comment.Text, Environ("USERNAME")), Len(Environ("USERNAME"))).Font.Bold = True 'Make Bold the LAST occurrence of USERNAME

.AutoSize = True

End With

End With



'If there is no comment yet, create one and add username and timestamp

Else



With Target

.AddComment

With .Comment

.Shape.AutoShapeType = msoShapeRoundedRectangle

.Text Text:=Environ("USERNAME") & " " & Format(Now(), "ddd dd-mmm-yy hh:mm")

With .Shape.TextFrame

'.Characters(1, Len(Environ("USERNAME"))).Font.Bold = True

.AutoSize = True

End With

End With

End With



End If



'Embolden each occurrence of Environ("USERNAME") in each comment in E17:E55

For Each cCom In ActiveSheet.Range("E17:E65").SpecialCells(xlCellTypeComments)

With Cells(cCom.Row, cCom.Column).Comment.Shape.TextFrame

For i = 1 To Len(cCom.Comment.Text) Step 1[/CODE]
[/CODE]

If Mid(cCom.Comment.Text, i, Len(Environ("USERNAME"))) = Environ("USERNAME") Then

.Characters(i, Len(Environ("USERNAME"))).Font.Bold = True

End If

Next i

End With

Next cCom

 

[skillilea]

It might be easier if you send me the worksheet and I can look at it. Is that an option? I don’t need sensitive data.

 

[Kellie220]

How would I send it to you?

 

[CephasOz]

Hi @Kellie220

I once had a similar need, and thought that the solution I have might be of interest (I have adapted it slightly for you). It avoids two problems with the original code that you quoted:

1. No comment is set if multiple cells are changed at the same time, and
2. No comment is set if the contents of the cell are deleted.

Anyway, have a look at the code and see if it is useful for you.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim strAudit As String
    Dim rngToAudit As Range
    Dim rngTgtCell As Range
    Dim rngTgtArea As Range
    Dim rngCell As Range
    Dim strUser As String
    Dim lngPosn As Long
    '
    'Change this range as appropriate.
    Set rngToAudit = ActiveSheet.Range("A2:A9999")
    '
    ' Are any of the changed cells within the audit range?
    If (Not (Intersect(Target, rngToAudit) Is Nothing)) Then
        ' They are, so comment them.
        strUser = Environ("USERNAME")
        strAudit = strUser & Space(1) & Format(Now(), "ddd dd mmm yy hh:mm")
        ' Process each Area.
        For Each rngTgtArea In Target.Areas
            ' Process each Cell within the Area.
            For Each rngTgtCell In rngTgtArea.Cells
                ' Is this particular cell in the audit range?
                If (Not (Intersect(rngTgtCell, rngToAudit) Is Nothing)) Then
                    ' It is.
                    If (rngTgtCell.Comment Is Nothing) Then
                        'There is no comment yet, so create one and add audit string.
                        With rngTgtCell
                            .AddComment
                            With .Comment
                                .Shape.AutoShapeType = msoShapeRoundedRectangle
                                .Text Text:=strAudit
                            End With
                        End With
                    Else
                        'Since a comment already exists, add a line feed before adding audit string.
                        With rngTgtCell.Comment
                            .Text Text:=strAudit & vbLf & .Text
                        End With
                    End If
                End If
            Next rngTgtCell
        Next rngTgtArea
        ' Bold all occurrences of the current UserName in each comment in given range.
        For Each rngCell In rngToAudit.SpecialCells(xlCellTypeComments)
            With rngCell.Comment
                ' Turn off bold completely for this comment.
                .Shape.TextFrame.Characters.Font.Bold = False
                ' Bold all occurrences of the current UserName in this Comment.
                lngPosn = InStr(1, .Text, strUser)
                Do While (lngPosn > 0)
                    .Shape.TextFrame.Characters(lngPosn, Len(strUser)).Font.Bold = True
                    lngPosn = InStr(lngPosn + 1, .Text, strUser)
                Loop
                ' AutoSize the comment.
                .Shape.TextFrame.AutoSize = True
            End With
        Next rngCell
    End If
End Sub

 

[Kellie220]

HI Cephas, thank you for your suggestion. I did test it out. I still have some of the issues I was inquiring about. There is a limit of what the text box holds. If I enter too long of a comment, it will not input it into the comments. I really need this as a storage of sorts for the History of our research. Also, I am still able to type directly into the cell, which (with the comment dialog box) I do not want. I would like all comments entered on the dialog box.
1st attempt was just the entry, 2nd attempt to see if I could type into the cell, 3rd attempt was a very lengthy comment (Which did not even show up), 4th attempt a simple entry that did show attempt #1 remained. But the lengthy attempt 3 did not capture.

 

[Kellie220]

It might be easier if you send me the worksheet and I can look at it. Is that an option? I don’t need sensitive data.

Let me know how I can send you my dataset. Thank you again for your help!!

 

[Kellie220]

Hi @Kellie220

I once had a similar need, and thought that the solution I have might be of interest (I have adapted it slightly for you). It avoids two problems with the original code that you quoted:

1. No comment is set if multiple cells are changed at the same time, and
2. No comment is set if the contents of the cell are deleted.

Anyway, have a look at the code and see if it is useful for you.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim strAudit As String
    Dim rngToAudit As Range
    Dim rngTgtCell As Range
    Dim rngTgtArea As Range
    Dim rngCell As Range
    Dim strUser As String
    Dim lngPosn As Long
    '
    'Change this range as appropriate.
    Set rngToAudit = ActiveSheet.Range("A2:A9999")
    '
    ' Are any of the changed cells within the audit range?
    If (Not (Intersect(Target, rngToAudit) Is Nothing)) Then
        ' They are, so comment them.
        strUser = Environ("USERNAME")
        strAudit = strUser & Space(1) & Format(Now(), "ddd dd mmm yy hh:mm")
        ' Process each Area.
        For Each rngTgtArea In Target.Areas
            ' Process each Cell within the Area.
            For Each rngTgtCell In rngTgtArea.Cells
                ' Is this particular cell in the audit range?
                If (Not (Intersect(rngTgtCell, rngToAudit) Is Nothing)) Then
                    ' It is.
                    If (rngTgtCell.Comment Is Nothing) Then
                        'There is no comment yet, so create one and add audit string.
                        With rngTgtCell
                            .AddComment
                            With .Comment
                                .Shape.AutoShapeType = msoShapeRoundedRectangle
                                .Text Text:=strAudit
                            End With
                        End With
                    Else
                        'Since a comment already exists, add a line feed before adding audit string.
                        With rngTgtCell.Comment
                            .Text Text:=strAudit & vbLf & .Text
                        End With
                    End If
                End If
            Next rngTgtCell
        Next rngTgtArea
        ' Bold all occurrences of the current UserName in each comment in given range.
        For Each rngCell In rngToAudit.SpecialCells(xlCellTypeComments)
            With rngCell.Comment
                ' Turn off bold completely for this comment.
                .Shape.TextFrame.Characters.Font.Bold = False
                ' Bold all occurrences of the current UserName in this Comment.
                lngPosn = InStr(1, .Text, strUser)
                Do While (lngPosn > 0)
                    .Shape.TextFrame.Characters(lngPosn, Len(strUser)).Font.Bold = True
                    lngPosn = InStr(lngPosn + 1, .Text, strUser)
                Loop
                ' AutoSize the comment.
                .Shape.TextFrame.AutoSize = True
            End With
        Next rngCell
    End If
End Sub

Thank you so much for reaching out. I will try this. I do appreciate your time!

 

[CephasOz]

1) From what I have been able to find out, comments have a storage limit of 32,767 characters, but only 1,024 display. So - are comments the best way to keep your information?
2) Comments are now referred to as Notes, and there are new comments which are referred to as Comments. The new Comments allow users to have conversations, and - to facilitate this exchange - each Comment is automatically labelled with the UserName and Date/Time of creation. Would these new Comments better serve your needs?
3) Protecting the cells from change, but simultaneously allowing (old) comment creation/update would seem impossible unless the approach that @skillilea suggested was used - that of updating the comments when the cell was selected, rather than when it was changed. You could then throw up an InputBox, accept text, unprotect the cell, update the (old) comment, and then re-protect the cell. If the user cancelled the InputBox, or failed to enter any text, the comment would be unchanged. Would this approach work for you? (Requires that users are allowed to select protected cells, that a password was used for worksheet protection, and necessarily that that password was used in VBA to protect/unprotect the worksheet on the fly.)

To help with the protect/unprotect requirement, here's the procedures that I use (note: assumes all worksheets in the workbook have the same password, so change SheetPwd to return your password).

' Password protect a given spreadsheet.
Function ProtectSheet(wks As Worksheet) As Boolean
    On Error GoTo Err_Exit
    ProtectSheet = False
    wks.Protect Password:=SheetPwd(), UserInterfaceOnly:=True
    ProtectSheet = WksIsProtected(wks)
Housekeeping:
    Exit Function
Err_Exit:
    Err.Clear
    Resume Housekeeping
End Function

' Unprotect a given spreadsheet.
Function UnProtectSheet(wks As Worksheet) As Boolean
    On Error GoTo Err_Exit
    UnProtectSheet = False
    wks.Unprotect Password:=SheetPwd()
    UnProtectSheet = (Not WksIsProtected(wks))
Housekeeping:
    Exit Function
Err_Exit:
    Err.Clear
    Resume Housekeeping
End Function

' Unprotect the active sheet.
Private Function UnProtectActive() As Boolean
    UnProtectActive = UnProtectSheet(ActiveSheet)
End Function

' Protect the active sheet.
Private Function ProtectActive() As Boolean
    ProtectActive = ProtectSheet(ActiveSheet)
End Function

' Determine if the given worksheet is protected.
Function WksIsProtected(wks As Worksheet) As Boolean
    On Error GoTo Err_Exit
    WksIsProtected = (wks.ProtectContents Or wks.ProtectScenarios Or wks.ProtectDrawingObjects)
Housekeeping:
    Exit Function
Err_Exit:
    Err.Clear
    Resume Housekeeping
End Function

' Return the password used to protect the spreadsheets.
Private Function SheetPwd() As String
    SheetPwd = "j%^pW@]D#d!4"
End Function

 

[Kellie220]

1) From what I have been able to find out, comments have a storage limit of 32,767 characters, but only 1,024 display. So - are comments the best way to keep your information?
2) Comments are now referred to as Notes, and there are new comments which are referred to as Comments. The new Comments allow users to have conversations, and - to facilitate this exchange - each Comment is automatically labelled with the UserName and Date/Time of creation. Would these new Comments better serve your needs?
3) Protecting the cells from change, but simultaneously allowing (old) comment creation/update would seem impossible unless the approach that @skillilea suggested was used - that of updating the comments when the cell was selected, rather than when it was changed. You could then throw up an InputBox, accept text, unprotect the cell, update the (old) comment, and then re-protect the cell. If the user cancelled the InputBox, or failed to enter any text, the comment would be unchanged. Would this approach work for you? (Requires that users are allowed to select protected cells, that a password was used for worksheet protection, and necessarily that that password was used in VBA to protect/unprotect the worksheet on the fly.)

To help with the protect/unprotect requirement, here's the procedures that I use (note: assumes all worksheets in the workbook have the same password, so change SheetPwd to return your password).

' Password protect a given spreadsheet.
Function ProtectSheet(wks As Worksheet) As Boolean
    On Error GoTo Err_Exit
    ProtectSheet = False
    wks.Protect Password:=SheetPwd(), UserInterfaceOnly:=True
    ProtectSheet = WksIsProtected(wks)
Housekeeping:
    Exit Function
Err_Exit:
    Err.Clear
    Resume Housekeeping
End Function

' Unprotect a given spreadsheet.
Function UnProtectSheet(wks As Worksheet) As Boolean
    On Error GoTo Err_Exit
    UnProtectSheet = False
    wks.Unprotect Password:=SheetPwd()
    UnProtectSheet = (Not WksIsProtected(wks))
Housekeeping:
    Exit Function
Err_Exit:
    Err.Clear
    Resume Housekeeping
End Function

' Unprotect the active sheet.
Private Function UnProtectActive() As Boolean
    UnProtectActive = UnProtectSheet(ActiveSheet)
End Function

' Protect the active sheet.
Private Function ProtectActive() As Boolean
    ProtectActive = ProtectSheet(ActiveSheet)
End Function

' Determine if the given worksheet is protected.
Function WksIsProtected(wks As Worksheet) As Boolean
    On Error GoTo Err_Exit
    WksIsProtected = (wks.ProtectContents Or wks.ProtectScenarios Or wks.ProtectDrawingObjects)
Housekeeping:
    Exit Function
Err_Exit:
    Err.Clear
    Resume Housekeeping
End Function

' Return the password used to protect the spreadsheets.
Private Function SheetPwd() As String
    SheetPwd = "j%^pW@]D#d!4"
End Function

Hi
1. Column A we labeled as "comments", they are our history of research we have done on that row. Some have been tracked for years. We cannot lose the history. If there is another method, Notes, conversation, as long as it holds the history. We just named our Column A "Comments" just a name.
2. If the new comments can hold "unlimited" amount of information, this would work well for me.
3. This one is tricky. Funny part, my spreadsheet only protects Columns G thru BN (Or last Column) The first 6 columns are used for inputting, the rest for visual research. I do not know why I got an error about protection when column A isn't under the protection but the "worksheet" itself is protect. Does that make sense? Adding a screenshot. It is an Edit Range. Also we only have one worksheet in this workbook.

Side Note. We want to put this in the Cloud on a SharePoint. I know Marcos do not work in the Cloud? Maybe I am wrong in this?

 

[Kellie220]

1) From what I have been able to find out, comments have a storage limit of 32,767 characters, but only 1,024 display. So - are comments the best way to keep your information?
2) Comments are now referred to as Notes, and there are new comments which are referred to as Comments. The new Comments allow users to have conversations, and - to facilitate this exchange - each Comment is automatically labelled with the UserName and Date/Time of creation. Would these new Comments better serve your needs?
3) Protecting the cells from change, but simultaneously allowing (old) comment creation/update would seem impossible unless the approach that @skillilea suggested was used - that of updating the comments when the cell was selected, rather than when it was changed. You could then throw up an InputBox, accept text, unprotect the cell, update the (old) comment, and then re-protect the cell. If the user cancelled the InputBox, or failed to enter any text, the comment would be unchanged. Would this approach work for you? (Requires that users are allowed to select protected cells, that a password was used for worksheet protection, and necessarily that that password was used in VBA to protect/unprotect the worksheet on the fly.)

To help with the protect/unprotect requirement, here's the procedures that I use (note: assumes all worksheets in the workbook have the same password, so change SheetPwd to return your password).

' Password protect a given spreadsheet.
Function ProtectSheet(wks As Worksheet) As Boolean
    On Error GoTo Err_Exit
    ProtectSheet = False
    wks.Protect Password:=SheetPwd(), UserInterfaceOnly:=True
    ProtectSheet = WksIsProtected(wks)
Housekeeping:
    Exit Function
Err_Exit:
    Err.Clear
    Resume Housekeeping
End Function

' Unprotect a given spreadsheet.
Function UnProtectSheet(wks As Worksheet) As Boolean
    On Error GoTo Err_Exit
    UnProtectSheet = False
    wks.Unprotect Password:=SheetPwd()
    UnProtectSheet = (Not WksIsProtected(wks))
Housekeeping:
    Exit Function
Err_Exit:
    Err.Clear
    Resume Housekeeping
End Function

' Unprotect the active sheet.
Private Function UnProtectActive() As Boolean
    UnProtectActive = UnProtectSheet(ActiveSheet)
End Function

' Protect the active sheet.
Private Function ProtectActive() As Boolean
    ProtectActive = ProtectSheet(ActiveSheet)
End Function

' Determine if the given worksheet is protected.
Function WksIsProtected(wks As Worksheet) As Boolean
    On Error GoTo Err_Exit
    WksIsProtected = (wks.ProtectContents Or wks.ProtectScenarios Or wks.ProtectDrawingObjects)
Housekeeping:
    Exit Function
Err_Exit:
    Err.Clear
    Resume Housekeeping
End Function

' Return the password used to protect the spreadsheets.
Private Function SheetPwd() As String
    SheetPwd = "j%^pW@]D#d!4"
End Function

Side note: You use Boolean? I was looking this up, can Variant be used? I am newer to all this, just checking.

 

[CephasOz]

1) I get a sense of the importance that you attach to this data. If it's that important, that critical, would you be better off moving to a database where you could have related comments that weren't limited in either length or number?
3) With $A:$F being an edit range, once the password for that range has been entered, it is active for that session, and that range can be edited. However, that password must be entered before that can happen. You're better off turning off the Locked attribute for that range, then protecting the worksheet. Then anyone who can open the workbook can edit those cells. (If you want to limit who can edit the workbook, then add a password to the workbook.)

Note: If you handle the changes to the A column solely in your VBA code, then column A doesn't need to be included in either the edit range or the unlocked cells, whichever option you choose. If you display an InputBox asking for a comment, then unprotect the worksheet, add the new comment, then protect the worksheet again, you've achieved the protection and functionality that you want.

My understanding is that macros don't work in Excel on the web, however it shouldn't make any difference where the file is stored - cloud or not - if you are using it in 365. If you want macro-type functionality, but in Excel on the web, then you will need to code in another language.

Yes, I use Boolean because protection is either on or off. So you would use it in the code like so:

If UnProtectSheet(ActiveSheet) Then
    ' Do something'
    If ProtectSheet(ActiveSheet) Then
        ' Do another thing
    End If
End If

Note: the functions ProtectActive() and UnProtectActive() listed in my previous post should not be marked Private; both should have the word Private deleted.

In thinking about your requirements, if it's true that:
A) Column A is reserved for comments.
B) Users should, but don't have to, add a comment for any change they make.
then the following code in your worksheet code module should give the result that you want.

Private Sub Worksheet_Change(ByVal Target As Range)
    Const cstrTitle As String = "Add Comment"
    Const clngColA As Long = 1   ' Column for comments
    Dim strAudit As String
    Dim rngToAudit As Range
    Dim rngTgtCell As Range
    Dim rngTgtArea As Range
    Dim rngComment As Range
    Dim rngCell As Range
    Dim strUser As String
    Dim lngPosn As Long
    Dim strComment As String
    Dim strErrMsg As String
    Dim bolUnprotected As Boolean
    '
    'Change this range as appropriate.
    Set rngToAudit = ActiveSheet.Range("E17:E65")
    strErrMsg = vbNullString
    bolUnprotected = False
    '
    ' Are any of the changed cells within the audit range?
    If (Not (Intersect(Target, rngToAudit) Is Nothing)) Then
        ' They are, so comment them.
        If UnProtectActive() Then
            bolUnprotected = True
            strUser = Environ("USERNAME")
            strAudit = strUser & Space(1) & Format(Now(), "ddd dd mmm yy hh:mm")
            ' Process each Area.
            For Each rngTgtArea In Target.Areas
                ' Process each Cell within the Area.
                For Each rngTgtCell In rngTgtArea.Cells
                    ' Is this particular cell in the audit range?
                    If (Not (Intersect(rngTgtCell, rngToAudit) Is Nothing)) Then
                        ' It is.
                        rngTgtCell.Select
                        strComment = Application.InputBox("Comment for Row " & rngTgtCell.Row, cstrTitle, vbNullString)
                        If (Not (strComment = "False")) Then
                            strComment = strAudit & vbLf & strComment
                            Set rngComment = Me.Cells(rngTgtCell.Row, clngColA)
                            If (rngComment.Comment Is Nothing) Then
                                'There is no comment yet, so create one and add audit string.
                                With rngComment
                                    .AddComment
                                    With .Comment
                                        .Shape.AutoShapeType = msoShapeRoundedRectangle
                                        .Text Text:=strComment
                                    End With
                                End With
                            Else
                                'Since a comment already exists, add a line feed after audit string.
                                With rngComment.Comment
                                    .Text Text:=strComment & vbLf & .Text
                                End With
                            End If
                        End If
                    End If
                Next rngTgtCell
            Next rngTgtArea
            ' Bold all occurrences of the current UserName in each comment in given range.
            For Each rngCell In Me.Columns(clngColA).SpecialCells(xlCellTypeComments)
                With rngCell.Comment
                    ' Turn off bold completely for this comment.
                    .Shape.TextFrame.Characters.Font.Bold = False
                    ' Bold all occurrences of the current UserName in this Comment.
                    lngPosn = InStr(1, .Text, strUser)
                    Do While (lngPosn > 0)
                        .Shape.TextFrame.Characters(lngPosn, Len(strUser)).Font.Bold = True
                        lngPosn = InStr(lngPosn + 1, .Text, strUser)
                    Loop
                    ' AutoSize the comment.
                    .Shape.TextFrame.AutoSize = True
                End With
            Next rngCell
        End If
    End If
Housekeeping:
    If bolUnprotected Then
        ProtectActive
    End If
    ' Display any error message.
    If (Trim(strErrMsg) <> vbNullString) Then
        MsgBox strErrMsg, vbCritical + vbOKOnly, cstrTitle
    End If
    Exit Sub
Err_Exit:
    strErrMsg = Err.Number & ": " & Err.Description
    Err.Clear
    Resume Housekeeping
End Sub

Then the protection procedures can be put into a regular module.

' Return the password used to protect the spreadsheets.
Private Function SheetPwd() As String
    SheetPwd = "P@^pW@7]D#!4"
End Function

' Password protect all spreadsheets.
Function ProtectAllSheets() As Boolean
    Dim wks As Worksheet
    Dim bolResult As Boolean
    '
    ProtectAllSheets = False
    On Error GoTo Err_Exit
    bolResult = True
    For Each wks In Worksheets
        bolResult = bolResult And ProtectSheet(wks)
    Next
    ProtectAllSheets = bolResult
Housekeeping:
    Exit Function
Err_Exit:
    Err.Clear
    Resume Housekeeping
End Function

' Unprotect all worksheets.
Function UnProtectAllSheets() As Boolean
    Dim wks As Worksheet
    Dim bolResult As Boolean
    '
    UnProtectAllSheets = False
    On Error GoTo Err_Exit
    bolResult = True
    For Each wks In ThisWorkbook.Worksheets
        bolResult = bolResult And UnProtectSheet(wks)
    Next
    UnProtectAllSheets = bolResult
Housekeeping:
    Exit Function
Err_Exit:
    Err.Clear
    Resume Housekeeping
End Function

' Password protect a given spreadsheet.
Function ProtectSheet(wks As Worksheet) As Boolean
    On Error GoTo Err_Exit
    ProtectSheet = False
    wks.Protect Password:=SheetPwd(), UserInterfaceOnly:=True
    ProtectSheet = WksIsProtected(wks)
Housekeeping:
    Exit Function
Err_Exit:
    Err.Clear
    Resume Housekeeping
End Function

' Unprotect a given spreadsheet.
Function UnProtectSheet(wks As Worksheet) As Boolean
    On Error GoTo Err_Exit
    UnProtectSheet = False
    wks.Unprotect Password:=SheetPwd()
    UnProtectSheet = (Not WksIsProtected(wks))
Housekeeping:
    Exit Function
Err_Exit:
    Err.Clear
    Resume Housekeeping
End Function

' Unprotect the active worksheet.
Function UnProtectActive() As Boolean
    UnProtectActive = UnProtectSheet(ActiveSheet)
End Function

' Protect the active worksheet.
Function ProtectActive() As Boolean
    ProtectActive = ProtectSheet(ActiveSheet)
End Function

' Determine if the given worksheet is protected.
Function WksIsProtected(wks As Worksheet) As Boolean
    'Debug.print "WksIsProtected"
    On Error GoTo Err_Exit
    WksIsProtected = (wks.ProtectContents Or wks.ProtectScenarios Or wks.ProtectDrawingObjects)
Housekeeping:
    Exit Function
Err_Exit:
    Err.Clear
    Resume Housekeeping
End Function

' Is a given worksheet protected with a password?
Function HasPassword(wks As Worksheet) As Boolean
    Dim bolScrnUpdating As Boolean
    bolScrnUpdating = Application.ScreenUpdating
    HasPassword = False
    Application.ScreenUpdating = False
    If wks.ProtectContents Then
        On Error Resume Next
        wks.Protect Password:="", Contents:=False
        If Err = 1004 Then
            HasPassword = True
        End If
        On Error GoTo 0
    End If
    If bolScrnUpdating Then
        Application.ScreenUpdating = True
    End If
End Function

' Protect the workbook.
Function ProtectWorkbook() As Boolean
    'Debug.print "ProtectWorkbook"
    ProtectWorkbook = False
    On Error GoTo Err_Exit
    ThisWorkbook.Protect Password:=SheetPwd(), Structure:=True
    ProtectWorkbook = True
Housekeeping:
    Exit Function
Err_Exit:
    Err.Clear
    Resume Housekeeping
End Function

' Unprotect the workbook.
Function UnprotectWorkbook() As Boolean
    'Debug.print "UnprotectWorkbook"
    UnprotectWorkbook = False
    On Error GoTo Err_Exit
    ThisWorkbook.Unprotect Password:=SheetPwd()
    UnprotectWorkbook = True
Housekeeping:
    Exit Function
Err_Exit:
    Err.Clear
    Resume Housekeeping
End Function

' Determine if the workbook is protected.
Function WorkbookIsProtected() As Boolean
    'Debug.print "WorkbookIsProtected"
    WorkbookIsProtected = (ThisWorkbook.ProtectStructure Or ThisWorkbook.ProtectWindows)
Housekeeping:
    Exit Function
Err_Exit:
    Err.Clear
    Resume Housekeeping
End Function

Once the respective pieces of code are in place:
1) Change the procedure SheetPwd to be whatever your password is, and
2) Run the procedure ProtectActive.
Then you should be set for testing.