J
Jeff Mackeny
I have the following code to gather all notes to a new sheet, can anyone
help me change this to open a new workbook
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 <-- this is on clue, what else??
newwks.Range("A1:E1").Value = _
Array("Sheet", "Address", "Name", "Value", "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.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
help me change this to open a new workbook
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 <-- this is on clue, what else??
newwks.Range("A1:E1").Value = _
Array("Sheet", "Address", "Name", "Value", "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.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