Macro to pull Office 365 'Comments' onto new tab like I previously did with what's now 'Notes'

jkouvel

New Member
Joined
Nov 14, 2014
Messages
4
Office Version
  1. 365
Hi. I had cobbled together a macro based on various threads I found to create a new tab in workbook and list detail for any cells on any/all tabs with the yellow box comments. It showed the location of comment, the text in the cell, and then my comment text. It was helpful to me when I went back to review workpapers where I left comments for my team to see what was there before they revised or moved it. I've recently been migrated to Office 365 and the macro no longer works and it's making tracking whether items were addressed when the cell is now blank but my comment remains (I don't know what was previously there to see if it's been moved somewhere else).

I'm not savvy enough with VBA to know how to fix it to now pull the new 'Comments' section vs. now what's reflected as 'Notes' in the Review toolbar. I tried changing 'mycell.Comment.Text' to mycell.CommentThreaded.Text' but it didn't make a difference; still produces a blank Review Notes tab. Can someone help?

Before O365 migration (macro was based on this Comments section - green highlight)
1728315793231.png


Post migration (now need to have it look for this section - green highlight now considered 'Notes')
1728315854154.png



VBA Code:
Sub ShowCommentsAllSheets()

'summarizes all review comment boxes in workbook
  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("A5:D5").Value = _
     Array("Tab", "Cell", "Cell Value / Description", "Review 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
    'do nothing
  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.Value
         .Cells(i, 4).Value = mycell.Comment.Text
       End With
    Next mycell
  End If
  Set commrange = Nothing
Next ws
 

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
I can't figure out how to remove this post but after 3hrs more of googling, I figured it out. I don't understand why my last revision worked - learning point for another day - but it did.
 
Upvote 0

Forum statistics

Threads
1,224,462
Messages
6,178,816
Members
452,881
Latest member
motivationgyan

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
Back
Top