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
 
G

Guest

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

Comment 1
adjusting a VB script to my needs 4
Add Comments to Word 1
macro trouble 1
Print macro using xlDialogPrinterSetup fails to use driver-specific settings 0
multiple cells text to text in one cell 3
Exporting multiple rows from access to excel, each in a new row 2
Coding Help 5

Top