Disabling notes/comments using VBA

**Rob Wood** · 04-01-2020, 03:38 PM

Hi There,

I have an Excel with multiple notes/comments that I don't want all users to be able to edit or see. Whilst I can turn comments and indicators off using VBA code, they can easily be "turned back on" using Show Comments or Show Notes in the Ribbon.

Is there a way to password-protect the comments at all, or disable the Comments/Notes options in the Ribbon for users?

I've seen mention of a custom UI editor, but not sure I follow that approach.

Looking for some advice.

Thanks,

Rob.

**nankw83** · 04-01-2020, 06:55 PM

Hello … I am not really sure if that's doable but you can save all comments in a very hidden sheet then restore them when needed using the 2 below macros

Sub HideCommets()

Dim Cmt As Comment, Arr As Variant, Cnt As Long, Ws As Worksheet, Flg As Boolean

ReDim Arr(1 To ActiveSheet.Comments.Count, 1 To 2)
For Each Cmt In ActiveSheet.Comments
    Cnt = Cnt + 1
    Arr(Cnt, 1) = Cmt.Parent.Address(0, 0)
    Arr(Cnt, 2) = Cmt.Text
    Cmt.Delete
Next

For Each Ws In Worksheets
    If Ws.Name = "HiddenComments" Then
        Flg = True
        Exit For
    End If
Next Ws
    
If Flg = False Then Sheets.Add.Name = "HiddenComments"

With Sheets("HiddenComments")
    .UsedRange.ClearContents
    .Range("A1").Resize(, UBound(Arr, 2)) = Array("Comment Address", "Comment Text")
    .Range("A2").Resize(UBound(Arr), UBound(Arr, 2)) = Arr
    .UsedRange.Columns.AutoFit
    .Visible = xlSheetVeryHidden
End With

End Sub

Sub UnHideComments()

Dim Arr As Variant
Arr = Sheets("HiddenComments").Range("A1").CurrentRegion

For x = 2 To UBound(Arr)
    With Range(Arr(x, 1))
        If .Comment Is Nothing Then
            .AddComment
            .Comment.Text Arr(x, 2)
        Else
            .Comment.Text Arr(x, 2)
        End If
    End With
Next

End Sub

**Rob Wood** · 04-02-2020, 06:29 AM

Hi nankw83 - Thanks for responding.

I tried using your code for hiding comments on my Sheet2 on workbook open; however, it errors out at the ReDim (Subscript out of range).

Any suggestions here?

Thanks,

Rob.

**nankw83** · 04-02-2020, 06:40 AM

It could be that there are no comments in "ActiveSheet" when you open the file … Try the below code & see if it errors out

Sub HideCommets()

Dim Cmt As Comment, Arr As Variant, Cnt As Long, Ws As Worksheet, Flg As Boolean, Ws1 As Worksheet

Set Ws1 = Sheet1 '<--- change this to your target sheet
If Ws1.Comments.Count = 0 Then Exit Sub

ReDim Arr(1 To Ws1.Comments.Count, 1 To 2)
For Each Cmt In Ws1.Comments
    Cnt = Cnt + 1
    Arr(Cnt, 1) = Cmt.Parent.Address(0, 0)
    Arr(Cnt, 2) = Cmt.Text
    Cmt.Delete
Next

For Each Ws In Worksheets
    If Ws.Name = "HiddenComments" Then
        Flg = True
        Exit For
    End If
Next Ws
    
If Flg = False Then Sheets.Add.Name = "HiddenComments"

With Sheets("HiddenComments")
    .UsedRange.ClearContents
    .Range("A1").Resize(, UBound(Arr, 2)) = Array("Comment Address", "Comment Text")
    .Range("A2").Resize(UBound(Arr), UBound(Arr, 2)) = Arr
    .UsedRange.Columns.AutoFit
    .Visible = xlSheetVeryHidden
End With

End Sub

**nankw83** · 04-02-2020, 06:43 AM

And you can do the same for the UnHide macro

Sub UnHideComments()

Dim Arr As Variant, Ws1 As Worksheet
Arr = Sheets("HiddenComments").Range("A1").CurrentRegion

Set Ws1 = Sheet1 '<--- change this to your target sheet

For x = 2 To UBound(Arr)
    With Ws1.Range(Arr(x, 1))
        If .Comment Is Nothing Then
            .AddComment
            .Comment.Text Arr(x, 2)
        Else
            .Comment.Text Arr(x, 2)
        End If
    End With
Next

End Sub

**Rob Wood** · 04-02-2020, 08:01 AM

Using the revised VBA code, I'm no longer getting the error message, but it's also not hiding the comments on Sheet2. There are definitely 5 comments on Sheet2.

Any further suggestions here?

Thanks,

Rob.

**nankw83** · 04-02-2020, 08:03 AM

Sheet2 is the sheet name or sheet code name ? Did you change it in the code ?

**Rob Wood** · 04-02-2020, 08:05 AM

I did change the code to reflect Sheet2. Sheet2 is the code name, the sheet name is "Allocation". I ran the code step-by-step and it simply exits the sub suggestion there are no comments on Sheet2 when there definitely is...

Thanks,

Rob.

**nankw83** · 04-02-2020, 08:38 AM

Do you have comments or notes ? The code works for notes not comments

**CK76** · 04-02-2020, 08:45 AM

Rob, I'd recommend uploading sample workbook to clearly demonstrate your need. It'll be so much easier for us to help you when we have appropriate sample to work with.

**nankw83** · 04-02-2020, 04:57 PM

Hey Rob .. So I had some free time at home due to coronavirus curfew so it was a good opportunity to learn about Excel's new "comment" in VBA. I have revised the code significantly to accommodate for all comment & notes in all sheets of the workbook instead of only one sheet. I have also attached the sample file I was working on for your reference

VBA code for hiding all comments/notes

Sub HideAllComments()

Dim Ar1 As Variant, Cmt As Comment, CntCmt As Long
Dim Ar2 As Variant, CmtThrd As CommentThreaded, CntCmtThrd As Long
Dim Cnt As Long, Ws As Worksheet, Flg As Boolean, lRow As Long

For Each Ws In ThisWorkbook.Worksheets
    If Ws.Name = "HiddenComments" Then
        Ws.UsedRange.ClearContents
        Flg = True
        Exit For
    End If
Next Ws
    
If Flg = False Then Sheets.Add.Name = "HiddenComments"

For Each Ws In ThisWorkbook.Worksheets
    If Ws.Name <> "HiddenComments" Then
        If Ws.Comments.Count > 0 Then
            Cnt = 0
            CntCmt = CntCmt + Ws.Comments.Count
            ReDim Ar1(1 To Ws.Comments.Count, 1 To 4)
            For Each Cmt In Ws.Comments
                Cnt = Cnt + 1
                Ar1(Cnt, 1) = Ws.Name
                Ar1(Cnt, 2) = "Note"
                Ar1(Cnt, 3) = Cmt.Parent.Address(0, 0)
                Ar1(Cnt, 4) = Cmt.Text
                Cmt.Delete
            Next
        
            lRow = Sheets("HiddenComments").Range("A" & Rows.Count).End(xlUp).Row + 1
            With Sheets("HiddenComments")
                .Range("A1").Resize(, UBound(Ar1, 2)) = Array("Sheet CodeName", "Type", "Comment Address", "Comment Text")
                .Range("A" & lRow).Resize(UBound(Ar1), UBound(Ar1, 2)) = Ar1
            End With
        End If
        
        If Ws.CommentsThreaded.Count > 0 Then
            Cnt = 0
            CntCmtThrd = CntCmtThrd + Ws.CommentsThreaded.Count
            ReDim Ar2(1 To Ws.CommentsThreaded.Count, 1 To 4)
            For Each CmtThrd In Ws.CommentsThreaded
                Cnt = Cnt + 1
                Ar2(Cnt, 1) = Ws.Name
                Ar2(Cnt, 2) = "Comment"
                Ar2(Cnt, 3) = CmtThrd.Parent.Address(0, 0)
                Ar2(Cnt, 4) = CmtThrd.Text
                If CmtThrd.Replies.Count > 0 Then
                    For y = 1 To CmtThrd.Replies.Count
                        Ar2(Cnt, 4) = Ar2(Cnt, 4) & "|" & CmtThrd.Replies(y).Text
                    Next y
                End If
                CmtThrd.Delete
            Next
                    
            lRow = Sheets("HiddenComments").Range("A" & Rows.Count).End(xlUp).Row + 1
            With Sheets("HiddenComments")
                .Range("A1").Resize(, UBound(Ar2, 2)) = Array("Sheet CodeName", "Type", "Comment Address", "Comment Text")
                .Range("A" & lRow).Resize(UBound(Ar2), UBound(Ar2, 2)) = Ar2
            End With
        End If
   End If
Next Ws

Sheets("HiddenComments").Visible = xlSheetVeryHidden 'xlSheetVisible
lRow = Sheets("HiddenComments").Range("A" & Rows.Count).End(xlUp).Row
MsgBox "All Comments & Notes in this file are hidden successfully" & vbNewLine & _
     CntCmtThrd & " Comments + " & CntCmt & " Notes : Total = " & lRow - 1, vbInformation

End Sub

VBA code to show back all comments/notes

Sub ShowAllComments()

Dim Pass As String: Pass = "Nankw83" '<--- change the password to whatever suits you

If Application.InputBox("Please enter password to un-hide all comments and notes") <> Pass Then
    MsgBox "Incorrect Password !", vbCritical
    Exit Sub
End If

Dim Arr As Variant, Ws As Worksheet

With CreateObject("scripting.dictionary")
    For Each Ws In ThisWorkbook.Sheets
        If Not .exists(Ws.Name) Then .Add Ws.Name, Nothing
    Next
    If Not .exists("HiddenComments") Then
        MsgBox "No Comments or Notes are saved to be retrieved", vbExclamation
        Exit Sub
    End If
End With

Arr = Sheets("HiddenComments").Range("A1").CurrentRegion

For x = 2 To UBound(Arr)
    With Sheets(Arr(x, 1)).Range(Arr(x, 3))
        If Arr(x, 2) = "Note" Then
            If .Comment Is Nothing Then
                .AddComment
                .Comment.Text Arr(x, 4)
            Else
                .Comment.Text Arr(x, 4)
            End If
        ElseIf Arr(x, 2) = "Comment" Then
            If InStr(Arr(x, 4), "|") = 0 Then
                .AddCommentThreaded (Arr(x, 4))
            Else
                .AddCommentThreaded Split((Arr(x, 4)), "|")(0)
                For y = 1 To UBound(Split(Arr(x, 4), "|"))
                    .CommentThreaded.AddReply (Split(Arr(x, 4), "|")(y))
                Next y
            End If
        End If
    End With
Next x
  
MsgBox "All " & UBound(Arr) - 1 & " Comments & Notes are retrieved successfully", vbInformation

End Sub