adjusting a VB script to my needs

[DPeter2101]

I am having problems adjusting a VB script I got from a link off this
forum. It finds any cell in my work book that contains comments and
adds them to a new work sheet. It pulls
Sheet, Address, Name, Value and Comment. Sheet is the name of the work
sheet. Address is the cell ID. Name is not working for me (Not sure
what this should be pulling). Comments pull comments. What I need to
add to this is:

In my work book A5 to A70 are employee names. B5-70 to AF5-70 is where
there will be notes. If there is a note in B5 I would like to add the
name in A5 to the new work sheet in F1.

Any help would be appreciated!

Sub ShowCommentsAllSheets()
'modified from code
' by Dave Peterson
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: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

 

[Mike Fogleman]

The Name should be pulling the Range Name, if one was defined. There is
apparently no Name defined for the cells with Comments in them, so that
field is coming up empty. You could probably skip that column to save space.
As for the modification, is this related to where the CellComments are being
found, or is this completely non-related to this code?

Mike F

 

[Dave Peterson]

First, you can define a name for a single cell or a range of cells via
Insert|Name|define. That code shows that name if there was one defined.


===
So if I understand correctly, you can have comments in any cell in B5:AF70.

And if there's a comment in that range, you want to see what's in column A in
your "comment report".

This sounds like you wouldn't have to loop through all the sheets, too.

If that's true, this might be closer:

Option Explicit
Sub ShowCommentsAllSheets()

Application.ScreenUpdating = False

Dim CommRange As Range
Dim RngToInspect As Range
Dim myCell As Range
Dim ws As Worksheet
Dim newWks As Worksheet
Dim i As Long

With Worksheets("sheet1")
Set RngToInspect = .Range("b5:af70")
End With

Set newWks = Worksheets.Add

newWks.Range("A1:d1").Value _
= Array("Name", "Address", "Value", "Comment")

On Error Resume Next
Set CommRange = RngToInspect.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
.Cells(i, 1).Value = myCell.EntireRow.Cells(1).Value
.Cells(i, 2).Value = myCell.Address
.Cells(i, 3).Value = myCell.Value
.Cells(i, 4).Value = myCell.Comment.Text
End With
Next myCell
End If
Set CommRange = Nothing

End Sub

 

[DPeter2101]

Okay, I made a little change to get it to work and it is working. It i
getting the info I need but only from the one work sheet. (Januar
2005). How can I get it to look at all the pages in my work?




Option Explicit
Sub ShowCommentsAllSheets()

Application.ScreenUpdating = False

Dim CommRange As Range
Dim RngToInspect As Range
Dim myCell As Range
Dim ws As Worksheet
Dim newWks As Worksheet
Dim i As Long

With Worksheets("*January 2004*")

Set RngToInspect = .Range("B5:AF75")
End With

Set newWks = Worksheets.Add

newWks.Range("A1:E1").Value _
= Array("Name", *"Date*", "Address", "Value", "Comment")

On Error Resume Next
Set CommRange = RngToInspect.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
.Cells(i, 1).Value = myCell.EntireRow.Cells(1).Value
.*Cells(i, 2).Value = myCell.EntireColumn.Cells(2).Value*
.Cells(i, 3).Value = myCell.Address
.Cells(i, 4).Value = myCell.Value
.Cells(i, 5).Value = myCell.Comment.Text
End With
Next myCell
End If
Set CommRange = Nothing

End Su

 

[Dave Peterson]

One way:

Option Explicit
Sub ShowCommentsAllSheets()

Application.ScreenUpdating = False

Dim CommRange As Range
Dim RngToInspect As Range
Dim myCell As Range
Dim wks As Worksheet
Dim newWks As Worksheet
Dim i As Long

Set newWks = Worksheets.Add
newWks.Range("A1:f1").Value _
= Array("SheetName", "Name", "Date", "Address", "Value", "Comment")

For Each wks In ActiveWorkbook.Worksheets
If wks.Name = newWks.Name Then
'do nothing
Else
With wks
Set RngToInspect = .Range("B5:AF75")
End With

Set CommRange = Nothing
On Error Resume Next
Set CommRange = RngToInspect.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
.Cells(i, 1).Value = "'" & wks.Name
.Cells(i, 2).Value = myCell.EntireRow.Cells(1).Value
.Cells(i, 3).Value = myCell.EntireColumn.Cells(2).Value
.Cells(i, 4).Value = myCell.Address
.Cells(i, 5).Value = myCell.Value
.Cells(i, 6).Value = myCell.Comment.Text
End With
Next myCell
End If
End If
Next wks


End Sub

======
This is text only newsgroup. When you bold stuff in your posts, it shows up as
asterisks in many newsreaders. This just makes it more difficult to make
changes. It's easier if you indicate problems in plain text (to most readers,
anyway).