Excel VBA, Show comments on new sheet if the cell it is in is visible

Question

The title was hard to keep true to what I need in full so please read all the text.

I am trying to use a button to create a sheet that will show users all the comments on all the worksheets in an easy to understand format that basically acts as the highlights of the workbook.

The issue is the code currently shows ALL comments but I only wish for the person to see currently visible comments. What do I mean? Not all users can see all sheets or all columns and rows. Certain data is hidden because it does not pertain to them. I only want them to see data that is currently visible on any sheet they have as visible.

Example (NOT A REAL SITUATION); an excel document has 3 sheets (Sheet1, Sheet2, Sheet3). John logs in (using a Select Case VBA that hides data he does not need) and can see Sheet1 and Sheet2 but cannot see specific rows in each sheet such as Row 2 and column F in Sheet1 and Row 5 and Column K in Sheet2. He does not need to see the comments for the rows, columns, and sheets he cannot see.

How can I alter the code below to only display comments for cells he can see?

Note: I did not create this code, merely adopted it as it almost suits my needs.

    Sub ShowCommentsAllSheets()

  Application.ScreenUpdating = False

  Dim commrange As Range
  Dim mycell As Range
  Dim ws As Worksheet
  Dim newwks As Worksheet
  Dim i As Long

Set newwks = Worksheets.Add

 newwks.Range("A1:E1").Value = _
     Array("Sheet", "Address", "Name", "Value", "Comment")

For Each ws In ActiveWorkbook.Worksheets
  On Error Resume Next
  Set commrange = ws.Cells.SpecialCells(xlCellTypeComments)
  On Error GoTo 0

  If commrange Is Nothing Then

  Else

    i = newwks.Cells(Rows.Count, 1).End(xlUp).Row

    For Each mycell In commrange
       With newwks
         i = i + 1
         On Error Resume Next
         .Cells(i, 1).Value = ws.Name
         .Cells(i, 2).Value = mycell.Address
         .Cells(i, 3).Value = mycell.Name.Name
         .Cells(i, 4).Value = mycell.Value
         .Cells(i, 5).Value = mycell.Comment.Text
       End With
    Next mycell
  End If
  Set commrange = Nothing
Next ws


newwks.Cells.WrapText = False
newwks.Columns("E:E").Replace What:=Chr(10), _
  Replacement:=" ", LookAt:=xlPart, _
  SearchOrder:=xlByRows, MatchCase:=False, _
  SearchFormat:=False, ReplaceFormat:=False

Application.ScreenUpdating = True

End Sub

I believe I need to add this code to fix the problem:

   Comments = 1
   For Each MyComments In ActiveSheet.Comments
       If MyComments.Visible = True Then
           Comments = 0
       End If
   Next
   If Comments = 1 Then
       Application.DisplayCommentIndicator = xlCommentAndIndicator
   Else
       Application.DisplayCommentIndicator = xlCommentIndicatorOnly
   End If

However, I am struggling to fit this into the code. How should I proceed?

He does not need to see the comments for the rows, columns, and sheets he cannot see. If a comment is on a cell which is hidden then the user will not be able to see the comment. This is by default. Or have I misunderstood your question? — Siddharth Rout
Couldn't you just add an If to your loop to check if the sheet is visible. @SiddharthRout - think he means the code collects comments from sheets which the user should not be able to see. — SJR
Then simply check if the cell/sheet is hidden or not :) @SJR — Siddharth Rout
Hint: Check what does Debug.Print mycell.entirerow.Hidden, Debug.Print mycell.entirecolumn.Hidden and Debug.Print mycell.parent.visible does? ;) — Siddharth Rout
Think you should be able to manage it, but if you try something and it doesn't work come back. — SJR

SJR SJR · Accepted Answer · 2017-11-29T15:57:21

Code amended to cover visible sheets and then cells which are not hidden.

Sub ShowCommentsAllSheets()

Application.ScreenUpdating = False

Dim commrange As Range
Dim mycell As Range
Dim ws As Worksheet
Dim newwks As Worksheet
Dim i As Long

Set newwks = Worksheets.Add

newwks.Range("A1:E1").Value = _
  Array("Sheet", "Address", "Name", "Value", "Comment")

For Each ws In ActiveWorkbook.Worksheets
    If ws.Visible = xlSheetVisible Then
        On Error Resume Next
        Set commrange = ws.Cells.SpecialCells(xlCellTypeComments)
        On Error GoTo 0
        If Not commrange Is Nothing Then
            i = newwks.Cells(Rows.Count, 1).End(xlUp).Row
         For Each mycell In commrange
            If Not (mycell.EntireRow.Hidden Or mycell.EntireColumn.Hidden) Then
                With newwks
                  i = i + 1
                  On Error Resume Next
                  .Cells(i, 1).Value = ws.Name
                  .Cells(i, 2).Value = mycell.Address
                  .Cells(i, 3).Value = mycell.Name.Name
                  .Cells(i, 4).Value = mycell.Value
                  .Cells(i, 5).Value = mycell.Comment.Text
                End With
            End If
         Next mycell
        End If
        Set commrange = Nothing
        End If
Next ws

newwks.Cells.WrapText = False
newwks.Columns("E:E").Replace What:=Chr(10), _
Replacement:=" ", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False

Application.ScreenUpdating = True

End Sub

Excel VBA, Show comments on new sheet if the cell it is in is visible

1 Answers