Macro to Search for Comments in Closed Workbooks

jkouvel

New Member
Joined
Nov 14, 2014
Messages
2
Hello - I'm seeking a macro that would help me identify which files in a folder (including subfolders) have review comments in them. I searched through other posts but I couldn't find an answer or, I found something that could possibly be applied to my scenario (e.g. searching for 'x' in closed worksheets), but I'm not sure how to modify it accordingly to find comments vs. values or specific text. Example would be this thread: https://www.mrexcel.com/board/threads/finding-data-in-closed-workbooks-with-vba.950934/

In a 'good, better, best' fashion, my primary goal is to create a new spreadsheet that would list all file names where there are comments in worksheets (on any/all tabs); a reach goal would be to pull the comment detail into the new spreadsheet. But honestly, I'd be happy enough just knowing where to narrow my search to clear and remove comments in files before they're archived.

I do have a current macro designed to create a new sheet within the same workbook and listing all the comments with the respective tab, cell reference, and cell content but not sure if that could be modified to use to search across closed files in a folder. Any help would be appreciated!!

As a note, I'm using Excel 2019.



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
 
 
'format cells for no wrapping, remove line break
newwks.Cells.WrapText = False
newwks.Columns("D:D").Replace What:=Chr(10), _
  Replacement:=" ", LookAt:=xlPart, _
  SearchOrder:=xlByRows, MatchCase:=False, _
  SearchFormat:=False, ReplaceFormat:=False

Application.ScreenUpdating = True


'adjusts width and formatting of cells
Columns("C:D").Select
With Selection
.ColumnWidth = 75
.WrapText = True
End With

Columns("A:D").Select
With Selection
.VerticalAlignment = xlTop
.EntireColumn.AutoFit
End With

Columns("C").Select
With Selection
.HorizontalAlignment = xlHAlignLeft
.WrapText = True
End With

Columns("A").Select
With Selection
.HorizontalAlignment = xlHAlignLeft
End With


'minimum column width
Dim mCell As Range
Application.ScreenUpdating = False

For Each mCell In Columns("A")
mCell.EntireColumn.AutoFit
If mCell.EntireColumn.ColumnWidth > 15 Then _
mCell.EntireColumn.ColumnWidth = 15
Next mCell

For Each mCell In Columns("C")
mCell.EntireColumn.AutoFit
If mCell.EntireColumn.ColumnWidth > 50 Then _
mCell.EntireColumn.ColumnWidth = 50
Next mCell

Application.ScreenUpdating = True

Dim cl As Range

For Each cl In Columns("C:D")
If cl.WrapText Then cl.Rows.AutoFit
Next



'add titles and date to sheet
Range("A1").Value = "Review Comments"
Range("A1").Font.Size = 14
Range("A1").Font.FontStyle = "Bold"

Range("A2").Value = ActiveWorkbook.Name
Range("A2").Font.Size = 12
Range("A2").Font.FontStyle = "Bold"

With Range("D1")
.Value = Date
.NumberFormat = "m/d/yy"
End With



'add borders to header row
Range("A5:D5").Borders(xlEdgeLeft).LineStyle = xlContinuous
Range("A5:D5").Borders(xlEdgeRight).LineStyle = xlContinuous
Range("A5:D5").Borders(xlEdgeTop).LineStyle = xlContinuous
Range("A5:D5").Borders(xlEdgeBottom).LineStyle = xlContinuous
Range("A5:D5").Borders(xlInsideVertical).LineStyle = xlContinuous
Range("A5:D5").Interior.ColorIndex = 37



'formats borders for non-blank rows
Dim lngRows As Long

 With ActiveSheet
 For lngRows = 6 To .Cells(.Rows.Count, 1).End(xlUp).Row
 .Range("A" & lngRows & ":D" & lngRows).Borders(xlEdgeBottom).LineStyle = xlContinuous
 Next
 End With


'page formatting
With ActiveSheet.PageSetup
    .Zoom = False
    .FitToPagesWide = 1
    .LeftMargin = Application.InchesToPoints(0.5)
    .RightMargin = Application.InchesToPoints(0.5)
    .TopMargin = Application.InchesToPoints(0.5)
    .BottomMargin = Application.InchesToPoints(0.5)
End With


'filter out empty rows
ActiveSheet.Range("$A$5:$D$400").AutoFilter Field:=4, Criteria1:="<>", Operator:=xlFilterValues
    ActiveWindow.ScrollRow = 1


'renames sheet
ActiveSheet.Name = "Review Notes"


'formats new comment tab
For Each mCell In Columns("A:B")
mCell.EntireColumn.AutoFit
If mCell.EntireColumn.ColumnWidth > 15 Then _
mCell.EntireColumn.ColumnWidth = 15
Next mCell

For Each mCell In Columns("C")
mCell.EntireColumn.AutoFit
If mCell.EntireColumn.ColumnWidth > 50 Then _
mCell.EntireColumn.ColumnWidth = 50
Next mCell

For Each mCell In Columns("D")
mCell.EntireColumn.AutoFit
If mCell.EntireColumn.ColumnWidth > 75 Then _
mCell.EntireColumn.ColumnWidth = 75
Next mCell

Application.ScreenUpdating = True

For Each cl In Columns("A:D")
If cl.WrapText Then cl.Rows.AutoFit
Next

Columns("A").Select
With Selection
.HorizontalAlignment = xlHAlignLeft
End With


'changes new tab color
Sheets("Review Notes").Tab.ColorIndex = 3
'3=Red , 4=green,5=blue,6=yellow,etc.


End Sub
 

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand

Forum statistics

Threads
1,176,078
Messages
5,901,271
Members
434,884
Latest member
ares0027

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
Top