Excel – VBA – Extract a List of All The Comments on a Worksheet

Once again, while helping out in a forum, I developed a simple little sub routine I thought I’d share with everyone in the hopes it could serve others. You simply supply the name of a worksheet and the sub will then create a new worksheet in which it will then generate a table listing all the comments from the specified worksheet.

'---------------------------------------------------------------------------------------
' Procedure : Excel_ExtractComments
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Extracts all the comments from the specified worksheet and generates a
'             table listing all the comments found on a newly created sheet named
'             'Comment List'
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: None required
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sWorkSheetName    Name of the worksheet to extract all the comments from
'
' Usage:
' ~~~~~~
' Excel_ExtractComments "Sheet1"
' Call Excel_ExtractComments("WIP")
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2019-09-10              Initial Release, Forum Help
'---------------------------------------------------------------------------------------
Public Sub Excel_ExtractComments(sWorkSheetName As String)
    Dim WSSrc                 As Excel.Worksheet
    Dim WSDest                As Excel.Worksheet
    Dim oCom                  As Excel.Comment
    Dim i                     As Long
    Dim j                     As Long
    Const sDestSheetName = "Comment List"

    Application.DisplayAlerts = False

    'Ensure we start with a new fresh result sheet
    On Error Resume Next
    Set WSDest = Sheets(sDestSheetName)
    If Err.Number = 0 Then
        WSDest.Delete
    Else
        Err.Clear
    End If

    'Try and set a variable to the sheet from which to extract the comments from
    Set WSSrc = Sheets(sWorkSheetName)    'ActiveSheet
    If Err.Number <> 0 Then
        MsgBox "The specified sheet '" & sWorkSheetName & "' could not be found." & _
               "  Please verify the sheet name and try again.", _
               vbInformation Or vbOKOnly, "Sheet Not Found"
        GoTo Error_Handler_Exit
    End If

    On Error GoTo Error_Handler
    'Create a sheet to build our extracted data/results on
    Set WSDest = Worksheets.Add
    WSDest.Name = sDestSheetName

    'Build a summary title/date/total comments
    WSDest.Range("A1:D1").Merge True
    WSDest.Range("A2:D2").Merge True
    WSDest.Range("A3:D3").Merge True
    WSDest.Cells(1, 1).Value = "List of comments found on Sheet '" & sWorkSheetName & "'"
    WSDest.Cells(2, 1).Value = "Report generated " & Format(Now(), "yyyy-mmm-dd hh:nn")
    WSDest.Cells(3, 1).Value = WSSrc.Comments.Count & " comments extracted"

    'Build our data table
    'Build a header
    i = 5
    WSDest.Cells(i, 1).Value = "No."
    WSDest.Cells(i, 2).Value = "Cooment Address"
    WSDest.Cells(i, 3).Value = "Comment By"
    WSDest.Cells(i, 4).Value = "Comment"
    With WSDest.Range(WSDest.Cells(i, 1), _
                      WSDest.Cells(i, 4))
        .Font.Bold = True
        .Font.ColorIndex = 2
        .Interior.ColorIndex = 1
        .HorizontalAlignment = xlCenter
    End With
    'Get the actual comments
    For Each oCom In WSSrc.Comments
        i = i + 1
        j = j + 1
        'Sequential number
        WSDest.Cells(i, 1).Value = j
        'Cell address where the comment was located
        WSDest.Cells(i, 2).Value = oCom.Parent.Address
        'Hyperlink back to the originating cell
        WSDest.Cells(i, 2).Hyperlinks.Add Anchor:=WSDest.Cells(i, 2), Address:="", _
                                          SubAddress:=CStr(WSSrc.Name & "!" & oCom.Parent.Address)
        sComm = oCom.Text 'Full comment (Author and comment)
        'Author of the comment
        WSDest.Cells(i, 3).Value = Left(sComm, InStr(1, sComm, ":") - 1)
        sComm = Mid(sComm, InStr(1, sComm, ":") + 1)
        'Remove any leading carriage returns
        Do While Left(sComm, 1) = Chr(10)
            sComm = Mid(sComm, 2)
        Loop
        'Comment
        WSDest.Cells(i, 4).Value = sComm
    Next oCom
    'A little formatting to make things pretty
    WSDest.Columns("A:D").EntireColumn.AutoFit
    WSDest.Rows("6:" & i).EntireRow.AutoFit
    WSDest.Range("A1").Select  'Return to the top of the page

Error_Handler_Exit:
    On Error Resume Next
    Application.DisplayAlerts = True
    If Not oCom Is Nothing Then Set oCom = Nothing
    If Not WSDest Is Nothing Then Set WSDest = Nothing
    If Not WSSrc Is Nothing Then Set WSSrc = Nothing
    Exit Sub

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: Excel_ExtractComments" & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Sub

One response on “Excel – VBA – Extract a List of All The Comments on a Worksheet

  1. Subhadra

    Hi, the code works perfectly. Could you please advise what changes to be made in order to extract comments from the workbook instead of just one sheet.