Deleting comments

[camlad]

With recent help from Bob Alhat and Gary"s Student the macro below works
until there is a cell without a comment. I need an "If" statement which will
skip a "no comment" cell.

Please!

Camlad

Sub RemoveComments()
Count = 13
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
While LastRow > Count
If Cells(Count, 3).........(what do I put here for "has a
comment").............Then
CommentText = Cells(Count, 3).Comment.Text
Cells(Count, 2) = CommentText
Cells(Count, 3).Comment.Delete
End If
Count = Count + 1
Wend
End Sub

 

[Don Guillett]

Try this simple approach.

Sub delcomments()
Columns(1).ClearComments
End Sub

 

[Mike H]

maybe this which continues on error

Sub RemoveComments()
Count = 13
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
While LastRow > Count
On Error Resume Next
CommentText = Cells(Count, 3).Comment.Text
Cells(Count, 2) = CommentText
Cells(Count, 3).Comment.Delete
Count = Count + 1
CommentText = ""
Wend
End Sub

Mike

 

[camlad]

Thanks Mike, it was the "On Error Resume Next" I had forgotten.

Camlad

 

[Dave Peterson]

You don't have to use "on error" in this case. You can be more direct.

Option Explicit
Sub RemoveComments()
Dim iRow As Long
Dim LastRow As Long
Dim CommentText As String

iRow = 13
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
While LastRow > iRow
If .Cells(iRow, 3).Comment Is Nothing Then
'no comment
Else
CommentText = .Cells(iRow, 3).Comment.Text
.Cells(iRow, 2) = CommentText
.Cells(iRow, 3).Comment.Delete
End If
iRow = iRow + 1
Wend
End With
End Sub

If you have lots of cells but only a few cells with comments, you could just
look at the cells with comments this way:

Option Explicit
Sub RemoveComments2()
Dim myRng As Range
Dim myCell As Range

Dim LastRow As Long
Dim CommentText As String

With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set myRng = Nothing
On Error Resume Next
Set myRng = .Range("C13:C" & LastRow) _
.Cells.SpecialCells(xlCellTypeComments)
On Error GoTo 0

If myRng Is Nothing Then
'no comments in that range
Else
For Each myCell In myRng.Cells
CommentText = myCell.Comment.Text
.Cells(myCell.Row, 2) = CommentText
.Cells(myCell.Row, 3).Comment.Delete
Next myCell
End If
End With
End Sub

 

[Rick Rothstein]

Just out of curiosity, did you see the code I posted back in your original
thread? I still think it would be more efficient.

Sub RemoveComments()
Dim C As Comment
Const LastNonDeleteCommentRow As Long = 13
For Each C In Comments
If C.Parent.Row > LastNonDeleteCommentRow Then
C.Parent.Offset(, -1).Value = C.Text
C.Delete
End If
Next
End Sub

 

[Rick Rothstein]

Of course, it would have helped if I had restricted the copying of the
comments from Column "C" only though (which is what I believe the OP
wanted)...

Sub RemoveComments()
Dim C As Comment
Const LastNonDeleteCommentRow As Long = 13
For Each C In Comments
If C.Parent.Column = 3 Then
If C.Parent.Row > LastNonDeleteCommentRow Then
C.Parent.Offset(, -1).Value = C.Text
C.Delete
End If
End If
Next
End Sub

 

[Rick Rothstein]

HOWEVER, I'm thinking this should be the most efficient code...

Sub RemoveComments()
Dim R As Range
Const CommentColumn As String = "C"
Const FirstDeleteCommentRow As Long = 14
On Error GoTo NoComments
For Each R In Worksheets("Sheet8").Range( _
Cells(FirstDeleteCommentRow, CommentColumn), _
Cells(Rows.Count, CommentColumn)). _
SpecialCells(xlCellTypeComments)
R.Offset(, -1).Value = R.Comment.Text
R.Comment.Delete
Next
NoComments:
End Sub

as it only loops through the cells that actually have comments in them
within the column range of interest (if you have 2 cells with comments in
them in the desired column range, then the loop only iterates 2 times).

 

[Dave Peterson]

This line in the second suggestion:
..Cells(myCell.Row, 3).Comment.Delete
should be:
myCell.Comment.Delete

 

[Rick Rothstein]

Minor correction (as written, the two cell references inside the For..Each
Range reference are not guaranteed to point back to Sheet8)...

Sub RemoveComments()
Dim R As Range
Const CommentColumn As String = "D"
Const FirstDeleteCommentRow As Long = 14
On Error GoTo NoComments
With Worksheets("Sheet8")
For Each R In .Range(.Cells(FirstDeleteCommentRow, CommentColumn), _
.Cells(Rows.Count, CommentColumn)). _
SpecialCells(xlCellTypeComments)
R.Offset(, -1).Value = R.Comment.Text
R.Comment.Delete
Next
End With
NoComments:
End Sub

Of course, the OP should change the two Const statements and the With
statements so they represent his actual layout (I believe the Const
statements are correct though).