VBA to Create a Report of Cell Comments, Appending Data from Multiple Files

[lneidorf]

Hi there.

I'm attempting to create a user-friendly macro-enabled spreadsheet ("Comments Recap v2.xlsm") that will generate a report of the Excel cell Comments in selected Excel workbooks. I've got a nifty button that will enable the user to select a folder. After that, all the excel files therein are analyzed and new workbooks are created, with reports listing File Name, Sheet Name, Cell Address, Cell Value, and the actual Comment content.

All well and good, but instead of multiple new workbooks, I'd like to consolidate the output to a single tab in

It works, but the result is a separate new workbook with a report for each of the Excel files in the original directory. What I'd like instead is for all of this data to be written to a single tab in my original file. It would parse each of the spreadsheets in the directory, and add the resulting reports to a tab entitled "Comment Recap" contained in my "Comments Recap v2.xlsm" file.

I had tried a variety of inelegant approaches, including copying and pasting the data on all of these new workbooks to that tab, but that's no going well.

I have to think there's a way to send the output of the macro to this single tab, appending additional output beneath the existing values on that tab.

I reproduce my code below. I should note that it relies heavily upon two samples of code found online, each of which has been attributed.

Any help you can offer would be most appreciated.

Thanks!

Sub CombinedMacro1()
'Loop through all Excel files in a user specified folder and perform a set task on them
'https://www.thespreadsheetguru.com/the-code-vault/2014/4/23/loop-through-all-excel-files-in-a-given-folder

Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog

'Optimize Macro Speed
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.DisplayAlerts = False
  Application.Calculation = xlCalculationManual

'Retrieve Target Folder Path From User
  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

    With FldrPicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With

'In Case of Cancel
NextCode:
  myPath = myPath
  If myPath = "" Then GoTo ResetSettings

'Target File Extension (must include wildcard "*")
  myExtension = "*.xls*"

'Target Path with Ending Extention
  myFile = Dir(myPath & myExtension)

'Loop through each Excel file in folder
  Do While myFile <> ""
    'Set variable equal to opened workbook
    Set wb = Workbooks.Open(Filename:=myPath & myFile, UpdateLinks:=0)    'Added the UpdateLinks option to prevent dialog asking to update external links.
    
    'Ensure Workbook has opened before moving on to next line of code
    DoEvents
    
    
    'INSERT CODE HERE
        'https://www.extendoffice.com/documents/excel/679-list-all-comments-workbook.html
        Dim commrange As Range
        Dim rng As Range
        Dim ws As Worksheet
        Dim newWs As Worksheet
        Set newWs = Application.Worksheets.Add
        newWs.Name = "CommentSummary"
        newWs.Range("A1").Resize(1, 5).Value = Array("File Name", "Sheet Name", "Cell Address", "Cell Value", "Comment")
        Application.ScreenUpdating = False
        On Error Resume Next
        For Each ws In Application.ActiveWorkbook.Worksheets
            Set commrange = ws.Cells.SpecialCells(xlCellTypeComments)
            If Not commrange Is Nothing Then
                i = newWs.Cells(Rows.Count, 1).End(xlUp).Row
                For Each rng In commrange
                    i = i + 1
                    newWs.Cells(i, 1).Resize(1, 5).Value = Array(ActiveWorkbook.Name, ws.Name, rng.Address, rng.Value, rng.Comment.Text)
                Next
            End If
            Set commrange = Nothing
        Next
        
        'Move ActiveSheet to a new Workbook
        ActiveSheet.Move
        
            Range(Selection, Selection.End(xlToRight)).Select
            Selection.Font.Bold = True
            ActiveSheet.UsedRange.WrapText = False
        
            Columns("A:C").EntireColumn.AutoFit
            Range("D1:E1").Columns.AutoFit
            Range("A1").Select
            With ActiveWindow
                .SplitColumn = 0
                .SplitRow = 1
            End With
            ActiveWindow.FreezePanes = True
        
            newWs.Cells.WrapText = False
    '''''''''''''''''
    
    'Save and Close Workbook
      wb.Close savechanges:=True
      
    'Ensure Workbook has closed before moving on to next line of code
      DoEvents

    'Get next file name
      myFile = Dir
  Loop

'Message Box when tasks are completed
  MsgBox "All Excel files in the specified folder have been processed."

ResetSettings:
  'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.DisplayAlerts = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub