Return Author Comment

P

Pathogen

I am trying to dump some comment information contained in a
spreadsheet into a new spreadsheet. I found the below macro on the web
but need to include one more piece of information to the output. I
would like to include the Author name but am unsure how to do that.
Can anyone help??? Please see the code below:

Sub ShowCommentsAllSheets()
'modified from code
'posted by Dave Peterson 2003-05-16
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("A1:F1").Value = _
Array("Sheet", "Address", "Name", "Value", "Comment", "Author")

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.Name.Name
.Cells(i, 4).Value = mycell.Value
.Cells(i, 5).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("E:E").Replace What:=Chr(10), _
Replacement:=" ", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False

Application.ScreenUpdating = True

End Sub
 
B

Billy Liddel

Pathogen said:
I am trying to dump some comment information contained in a
spreadsheet into a new spreadsheet. I found the below macro on the web
but need to include one more piece of information to the output. I
would like to include the Author name but am unsure how to do that.
Can anyone help??? Please see the code below:

Sub ShowCommentsAllSheets()
'modified from code
'posted by Dave Peterson 2003-05-16
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("A1:F1").Value = _
Array("Sheet", "Address", "Name", "Value", "Comment", "Author")

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.Name.Name
.Cells(i, 4).Value = mycell.Value
.Cells(i, 5).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("E:E").Replace What:=Chr(10), _
Replacement:=" ", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False

Application.ScreenUpdating = True

End Sub
Click to expand...
Hi

add the new line below
.Cells(i, 5).Value = mycell.Comment.Text

newline:
.Cells(i, 6).Value = mycell.Comment.Author

Regards
Peter
 
D

Dave Peterson

Where can you get the author's name?

If it's the text before the first colon in the comment's text, you could strip
it by looking for the colon and taking everything before that character.

But if you're looking at the status bar and see "Cell A1 commented by Pathogen",
I'm not sure that can be gotten using VBA.

Option Explicit
Sub ShowCommentsAllSheets()
'modified from code
'posted by Dave Peterson 2003-05-16
Application.ScreenUpdating = False

Dim commrange As Range
Dim mycell As Range
Dim ws As Worksheet
Dim newwks As Worksheet
Dim i As Long
Dim ColonPos As Long

Set newwks = Worksheets.Add

newwks.Range("A1:F1").Value = _
Array("Sheet", "Address", "Name", "Value", "Comment", "Author")

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.Name.Name
.Cells(i, 4).Value = mycell.Value
.Cells(i, 5).Value = mycell.Comment.Text
ColonPos = InStr(1, mycell.Comment.Text, ":", vbTextCompare)
If ColonPos > 0 Then
.Cells(i, 6).Value = Left(mycell.Comment.Text, ColonPos - 1)
End If
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("E:E").Replace What:=Chr(10), _
Replacement:=" ", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False

Application.ScreenUpdating = True

End Sub
 
G

Gord Dibben

How about this alteration?

Option Explicit
Sub ShowCommentsAllSheets()
'modified from code
'posted by Dave Peterson 2003-05-16
Application.ScreenUpdating = False

Dim commrange As Range
Dim mycell As Range
Dim ws As Worksheet
Dim newwks As Worksheet
Dim i As Long
Dim ColonPos As Long

Set newwks = Worksheets.Add

newwks.Range("A1:F1").Value = _
Array("Sheet", "Address", "Name", "Value", "Comment", "Author")

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.Name.Name
.Cells(i, 4).Value = mycell.Value
.Cells(i, 5).Value = mycell.Comment.Text
.Cells(i, 6).Value = ActiveWorkbook.BuiltinDocumentProperties _
("Author")
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("E:E").Replace What:=Chr(10), _
Replacement:=" ", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False

Application.ScreenUpdating = True

End Sub


Gord
 
P

Pathogen

Hi

add the new line below
.Cells(i, 5).Value = mycell.Comment.Text

newline:
.Cells(i, 6).Value = mycell.Comment.Author

Regards
Peter
Click to expand...

This worked perfectly...thanks!
 
D

Dave Peterson

This'll get the author of the workbook--not the author of the comment.

I'll go with Billy's response (now that I know it exists <vbg>).
 
G

Gord Dibben

But Author may be different than username in the comment.

See my tweaker to return both.


Gord
 
P

Pathogen

Not necessarily. Sometimes a user will delete the Author name from
the content (text) of the comment. This is why I needed to have the
Comment.Author.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

VBA Coding Help for Beginner 0
Comment 1
adjusting a VB script to my needs 4
Word macro that can call cells out of Excel for a find and replace 0
Add Comments to Word 1
Lookup formula 0
macro trouble 1
Export specific fields from access to Excel 0

Top