Log In
Register
Home
December 4, 2021
Offline
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
November 8, 2013
Offline
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
December 4, 2021
Offline
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.
November 8, 2013
Offline
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
December 4, 2021
Offline
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)
December 4, 2021
Offline
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
November 8, 2013
Offline
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
December 4, 2021
Offline
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
November 8, 2013
Offline
My mistake:
Instead of :
MsgBox "No threaded comments found in " * wks.Name
Should be:
MsgBox "No threaded comments found in " & wks.Name
December 4, 2021
Offline
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.
November 8, 2013
Offline
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.
December 4, 2021
Offline
@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.
November 8, 2013
Offline
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.
December 4, 2021
Offline
It is still showing 35 reply columns. I made the change you stated, and I don't understand why it does this.
November 8, 2013
Offline
Are there missing comments anymore?
Please post a sample file where the code adds 35 comment columns and there should not be this many.
December 4, 2021
Offline
Sorry for no response, I have been out of town again. I am attempting to create a "dummy file. But I am having to create something from scratch, as I cannot post my live file. I am working on it.
December 4, 2021
Offline
My test file seems to work file (file attached), however my live file gives an error Runtime error 13 Type Mismatch, and then results in the comments sheets with NO comments, but there are a ton of comments in this workbook. And NO my live data file is not protected, and macros were enabled.
November 8, 2013
Offline
No file attached.
Can you upload a screenshot with the line in code that returns that error? When you press debug, that line is highlighted.
December 4, 2021
Offline
@Catalin,
Sorry for the delay, we have had a busy 2 weeks preparing for month end. Attached are the screenshots you requested. Sorry about forgetting the test, attached this time.
November 8, 2013
Offline
Hi Sherry,
That error was solved, you are using an old version. Use the file sent on august 25
August 24, 2022 - 3:45 pmMy mistake:Instead of :
MsgBox "No threaded comments found in " * wks.Name
Should be:
MsgBox "No threaded comments found in " & wks.Name
Here is another advice that is not applied in your latest file:
This line:
i=1
should be above this line (outside any loop):
For Each wks In ThisWorkbook.Worksheets
1 Guest(s)
