Including blank rows in a series of comments (sugarthebeet)

[Guest]

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

 

[Tom Ogilvy]

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
col = "G"
On Error Resume Next
Set myrangeC = Columns(col).Cells.SpecialCells(xlCellTypeComments))
On Error goto 0
If myrangeC Is Nothing Then Exit sub
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
wsNew.Activate
Application.Calculation = xlCalculationAutomatic 'xl95 uses xlAutomatic
Application.ScreenUpdating = True
End Sub

 

[Guest]

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

 

[Tom Ogilvy]

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

 

[Guest]

Hi Tom,

Actually I get a runtime error '13' even after deleting that extra bracket.

What do you think?

 

[Tom Ogilvy]

A type mismatch error?

So what line of code is highlighted. What are the values of the variables
in that line of code when you get the error?