View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
Tom Ogilvy Tom Ogilvy is offline
external usenet poster
 
Posts: 27,285
Default Including blank rows in a series of comments (sugarthebeet)

I edited your code and failed to remove the extra Right paren on the end.

--
Regards,
Tom Ogilvy


"Sugarthebeet" wrote in message
...
Thank Tom, but the VB editor doesn't seem to like this line:

Set myrangeC = Columns(col).Cells.SpecialCells(xlCellTypeComments ))

Compile Error - Syntax Error

Know what to do?

SB

"Sugarthebeet" wrote:

I would like to exclude all comments except those in column G and

include
blank cells too. Can someone help me tweak this code?

Sub PrintCommentsByColumn()

Dim cell As Range
Dim myrange As Range, myrangeC As Range
Dim col As Long
Dim RowOS As Long
Dim wsSource As Worksheet
Dim wsNew As Worksheet
If ActiveSheet.Comments.Count = 0 Then
MsgBox "No comments in entire sheet"
Exit Sub
End If
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual 'xl95 uses xlManual
Set wsSource = ActiveSheet
Sheets.Add
Set wsNew = ActiveSheet
wsSource.Activate
With wsNew.Columns("A:C")
.VerticalAlignment = xlTop
.WrapText = True
End With
wsNew.Columns("B").ColumnWidth = 15
wsNew.Columns("C").ColumnWidth = 60
wsNew.PageSetup.PrintGridlines = True
RowOS = 2
wsNew.Cells(1, 3) = "'" & Application.ActiveWorkbook.FullName & " -- "

& _
Application.ActiveSheet.Name
For col = 1 To ActiveSheet.UsedRange.Columns.Count
Set myrangeC = Intersect(ActiveSheet.UsedRange, Columns(col), _
Cells.SpecialCells(xlCellTypeComments))
If myrangeC Is Nothing Then GoTo nxtCol
For Each cell In myrangeC
If Trim(cell.Comment.Text) < "" Then
RowOS = RowOS + 1
wsNew.Cells(RowOS, 1) = "'" & cell.Address(0, 0) & ":"
wsNew.Cells(RowOS, 2) = "'" & cell.Text
wsNew.Cells(RowOS, 3) = "'" & cell.Comment.Text
End If
Next cell
nxtCol:
Next col
wsNew.Activate
Application.Calculation = xlCalculationAutomatic 'xl95 uses

xlAutomatic
Application.ScreenUpdating = True
End Sub