For some reason this macro is not pulling ALL responses. I cannot figure out why. It DOES loop through the whole workbook, but does not display all replies. Also would love for the replies to always be in the 1st available cells. On the Comments tab, row 7, it uses reply 3 & 4, however, those 2 replies are the 1st and 2nd for that comment. And in my live version, there are some responses that are NOT showing up when I do the extraction. I believe these ones that are not showing up are due to the comment being "resolved". Can the VBA script be adjust to pull ALL comments, replies, and add another column if there is a resolved and indicate those notes too?
Sub ListCommentsRepliesThreaded()
Application.ScreenUpdating = False
Dim j As Long
Dim ws As Worksheet
Dim myCmt As CommentThreaded
Dim myRp As CommentThreaded
Dim curwks As Worksheet
Dim newwks As Worksheet
Dim myList As ListObject
Dim i As Long
Dim iR As Long
Dim iRCol As Long
Dim ListCols As Long
Dim cmtCount As Long
If Not Evaluate("ISREF('Comments'!A1)") Then
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Comments"
Else
Sheets("Comments").Cells.Clear
End If
Set ws = Sheets("Comments")
ws.Move Before:=Sheets(1)
With ws
.Range("A1:H1").Value = _
Array("Number", "Sheet", "Cell", "Author", "Date", "Replies", "User Name", "Text", "Additional Replies")
.ListObjects.Add(xlSrcRange, _
.Cells(1, 1) _
.CurrentRegion, , xlYes) _
.Name = "Table1"
End With
i = 1
j = 1
iRCol = 9
For Each curwks In Worksheets
If curwks.Name <> ws.Name Then
For Each myCmt In curwks.CommentsThreaded
With ws
i = i + 1
' On Error Resume Next
.Cells(i, 1).Value = i - 1 'number
.Cells(i, 2).Value = curwks.Name ' sheet
.Cells(i, 3).Value = myCmt.Parent.Address 'cell
.Cells(i, 4).Value = myCmt.Author.Name ' author
.Cells(i, 5).Value = myCmt.Date 'date
.Cells(i, 6).Value = myCmt.Replies.Count ' count
.Cells(i, 7).Value = Environ("Username") 'user name
.Cells(i, 8).Value = myCmt.Text ' text
' .Cells(i, 9).Value = myCmt.Parent.Address 'Additional Replies
If myCmt.Replies.Count > 1 Then
For iR = 1 To myCmt.Replies.Count
.Cells(1, iRCol).Value = "Reply " & j
.Cells(i, iRCol).Value _
= myCmt.Replies(iR).Author.Name _
& vbCrLf _
& myCmt.Replies(iR).Date _
& vbCrLf _
& myCmt.Replies(iR).Text
iRCol = iRCol + 1
j = j + 1
Next iR
End If
End With
Next myCmt
End If
Next
Set myList = ws.ListObjects(1)
myList.TableStyle = "TableStyleLight8"
ListCols = myList.DataBodyRange _
.Columns.Count
With myList.DataBodyRange
.Cells.VerticalAlignment = xlTop
.Columns.EntireColumn.ColumnWidth = 30
.Cells.WrapText = True
.Columns.EntireColumn.AutoFit
.rows.EntireRow.AutoFit
End With
Application.ScreenUpdating = True
End Sub
Hi Sherry,
I think there is a mistake here:
If myCmt.Replies.Count > 1 Then
The line does not handle the comments with 1 reply only. Should be:
If myCmt.Replies.Count >= 1 Then
That seems to work to some extent. But I am still having issues to where On this document I have 35 columns of comments. The ONLY time I should have more than 1 column of comments is when the "replies" is=2+, and then those comments should be in reply columns 1, 2, etc. On this particular document, (my live file), there is only ONE instance where the # of replies is 2. That comment is on reply columns 34 and 35. It should never matter the total number of replies. All replies should appear as Reply 1, and if there are additional, reply 2, reply 3. But this is simply crazy to have it like this.
Hi Sherry,
You should start writing comments from the first reply column at each comment.
This means you have to reset the reply column INSIDE the loop, not outside it:
iRCol = 9
For Each curwks In Worksheets
should be:
For Each curwks In Worksheets
iRCol = 9
The result was identical. 35 reply columns. And only the final row had 2 replays, and those 2 replies appeared in AP & AQ (reply column 34 & Reply Column 35)
This code is a variation on what I was using, it is better in some ways, and lacking in others. I think this would be the answer I need if a few minor adjustments could be made.
1. The new sheet (Sheet1), could be named "Comments", and placed on the far left, as the very first sheet.
2. The macro could go through ALL worksheets looking for comments
3. A new column inserted between A & B, so everything pushed to the right. The new column would be "sheet". So the name of the sheet would be identified in comment B (now), and then the cell address would be identified (now in column C).
I think this is a better resolution than attempting to modify the previous code I provided. Thanks again in agvance!
Sub ListCommentsRepliesThreaded()
Application.ScreenUpdating = False
Dim myCmt As CommentThreaded
Dim myRp As CommentThreaded
Dim curwks As Worksheet
Dim newwks As Worksheet
Dim myList As ListObject
Dim i As Long
Dim iR As Long
Dim iRCol As Long
Dim ListCols As Long
Dim cmtCount As Long
Set curwks = ActiveSheet
cmtCount = curwks.CommentsThreaded.Count
If cmtCount = 0 Then
MsgBox "No threaded comments found"
Exit Sub
End If
Set newwks = Worksheets.Add
newwks.Range("A1:F1").Value = _
Array("Number", "Cell", "Author", _
"Date", "Replies", "Text")
i = 1
For Each myCmt In curwks.CommentsThreaded
With newwks
i = i + 1
On Error Resume Next
.Cells(i, 1).Value = i - 1
.Cells(i, 2).Value = myCmt.Parent.Address
.Cells(i, 3).Value = myCmt.Author.Name
.Cells(i, 4).Value = myCmt.Date
.Cells(i, 5).Value = myCmt.Replies.Count
.Cells(i, 6).Value = myCmt.Text
If myCmt.Replies.Count > 1 Then
iR = 1
iRCol = 7
For iR = 1 To myCmt.Replies.Count
.Cells(1, iRCol).Value = "Reply " & iR
.Cells(i, iRCol).Value _
= myCmt.Replies(iR).Author.Name _
& vbCrLf _
& myCmt.Replies(iR).Date _
& vbCrLf _
& myCmt.Replies(iR).Text
iRCol = iRCol + 1
Next iR
End If
End With
Next myCmt
With newwks
.ListObjects.Add(xlSrcRange, _
.Cells(1, 1) _
.CurrentRegion, , xlYes) _
.Name = ""
End With
Set myList = newwks.ListObjects(1)
myList.TableStyle = "TableStyleLight8"
ListCols = myList.DataBodyRange _
.Columns.Count
With myList.DataBodyRange
.Cells.VerticalAlignment = xlTop
.Columns.EntireColumn.ColumnWidth = 30
.Cells.WrapText = True
.Columns.EntireColumn.AutoFit
.rows.EntireRow.AutoFit
End With
Application.ScreenUpdating = True
End Sub
Hi Sherry,
Try this version, I cleaned the code and reorganized it:
Application.ScreenUpdating = False
Dim myCmt As CommentThreaded
Dim myRp As CommentThreaded
Dim curwks As Worksheet
Dim newwks As Worksheet
Dim myList As ListObject
Dim i As Long
Dim iR As Long
Dim iRCol As Long
Dim ListCols As Long
Dim cmtCount As Long
Dim wks As Worksheet
Dim NewRow As ListRow
If SheetExists("Comments") = False Then
Set newwks = Worksheets.Add
newwks.Name = "Comments"
Else
Set newwks = ThisWorkbook.Worksheets("Comments")
newwks.UsedRange.Clear
End If
newwks.Range("A1:G1").Value = Array("Number", "Sheet", "Cell", "Author", "Date", "Replies", "Text")
Set myList = newwks.ListObjects.Add(xlSrcRange, newwks.Range("A1:G2"), , xlYes)
myList.Name = "Comments"
myList.TableStyle = "TableStyleLight8"
For Each wks In ThisWorkbook.Worksheets
If Not wks.Name Like "Comments" Then
Set curwks = wks
cmtCount = curwks.CommentsThreaded.Count
If cmtCount = 0 Then
MsgBox "No threaded comments found in " * wks.Name
'Exit Sub
End If
i = 1
For Each myCmt In curwks.CommentsThreaded
With newwks
i = i + 1
On Error Resume Next
.Cells(i, 1).Value = i - 1
.Cells(i, 2).Value = wks.Name
.Cells(i, 3).Value = myCmt.Parent.Address
.Cells(i, 4).Value = myCmt.Author.Name
.Cells(i, 5).Value = myCmt.Date
.Cells(i, 6).Value = myCmt.Replies.Count
.Cells(i, 7).Value = myCmt.Text
If myCmt.Replies.Count > 1 Then
iR = 1
iRCol = 8
For iR = 1 To myCmt.Replies.Count
.Cells(1, iRCol).Value = "Reply " & iR
.Cells(i, iRCol).Value _
= myCmt.Replies(iR).Author.Name _
& vbCrLf _
& myCmt.Replies(iR).Date _
& vbCrLf _
& myCmt.Replies(iR).Text
iRCol = iRCol + 1
Next iR
End If
End With
Next myCmt
End If
Next wks
With myList.DataBodyRange
.Cells.VerticalAlignment = xlTop
.Columns.EntireColumn.ColumnWidth = 30
.Cells.WrapText = True
.Columns.EntireColumn.AutoFit
.Rows.EntireRow.AutoFit
End With
Application.ScreenUpdating = True
End Sub
Function SheetExists(ByVal ShName As String) As Boolean
On Error Resume Next
SheetExists = Not ThisWorkbook.Worksheets(ShName) Is Nothing
End Function
I am getting an error message. "Run-time error '13'. Type Mismatch. When I clicked on the "debug" button, it showed this line of code. "..No threaded comments..." Which is bizarre, as this is the same workbook previously that contains 35 comments. Question, that debug comment also mentions "worksheet", is the code checking all the sheets within the workbook? There are no comments on the 1st sheet, but the 2nd sheet has 35 comments and the 3rd sheet has 2 comments
My mistake:
Instead of :
MsgBox "No threaded comments found in " * wks.Name
Should be:
MsgBox "No threaded comments found in " & wks.Name
Catalin,
If nothin else, I am confused. When I run the macro now, I get 3 separate message boxes that appear one after another (when ok is pressed), stating there are no comments.... but there ARE! I am on sheet1, when I run the macro, and the majority of the comments are on sheet 2. But logically, none of that should matter.
Hi Sherry,
Based on your initial sample file, the code works, you can see the results:
Are you sure they are comments? Maybe those are... Notes. They are different.
@Catalin,
There are comments (not notes) that were not displayed on the comments sheet when the macro was run. They ARE threaded comments. This screenshot is an example of TWO comments (or rather 1 comment & 1 reply) that do NOT display on the comments sheet. This screenshot was taken from the Quality Assessment Template sheet, cell D4 you will see the small purple triangle indicating threaded comments Attached is a spreadsheet and two screenshots.
Now I am confused:
If nothin else, I am confused. When I run the macro now, I get 3 separate message boxes that appear one after another (when ok is pressed), stating there are no comments.... but there ARE! I am on sheet1, when I run the macro, and the majority of the comments are on sheet 2. But logically, none of that should matter.
Here you're saying that the code does not find ANY comment, but from the last message I understand that only some of them are not displayed.
The error is related to the position of the line :
i=1
Now it is located above this line and "i" is reset to 1 when the sheet changes, therefore it will overwrite some comments from previous sheet:
For Each myCmt In curwks.CommentsThreaded
But it should be above this line (outside any loop):
For Each wks In ThisWorkbook.Worksheets
Once you move i=1 above the sheets loop, you'll get all comments.
It is still showing 35 reply columns. I made the change you stated, and I don't understand why it does this.
Are there missing comments anymore?
Please post a sample file where the code adds 35 comment columns and there should not be this many.
