Does Excel Range have existing Comment

[bkclaw113]

How do I determine if activesheet.Cells(1,1) has an associated comment object?


I am creating a process that will copy formulas from all cells on a worksheet and paste that formula into the comment for that cell.

****CODE
Const conEscapeString = "~~"

Public Sub CaptureFormulas(wks As Worksheet, lngRows As Long, lngCols As Long)
Dim lngRow As Long
Dim lngCol As Long
Dim strOrigCmnt As String
Dim strNewCmnt As String

For lngRow = 1 To lngRows
For lngCol = 1 To lngCols
If wks.Cells(lngRow, lngCol).Formula Like "=*" Then
strNewCmnt = conEscapeString & wks.Cells(lngRow, lngCol).Formula
[red]if <comment exists> then[/red]
strOrigcmnt=wks.cells(lngRow,lngCol).comment.text
wks.Cells(lngRow, lngCol).Comment.Text Text:= strorigcmnt & chr(13) & strnewcmnt
Else
wks.Cells(lngRow, lngCol).AddComment strNewCmnt
End If
End If
Next lngCol
Next lngRow

End Sub
**** END CODE

The red section is where I need a way to distinguish if a comment already exist for the that and I need to change the text property of the comment, or if it does not exist and I need to use the addcomment method.

 

[Zathras]

Here is one way (To test, put a comment in B1 but not A1):

Sub test()
Dim r As Range
  Set r = Range("A1:B1")
  MsgBox RetrieveComment(r.Cells(1, 1))
  MsgBox RetrieveComment(r.Cells(1, 2))
End Sub

Function RetrieveComment(ACell As Range) As String
  On Error GoTo NoComment
  RetrieveComment = ACell.Comment.Text
  On Error GoTo 0
  Exit Function
NoComment:
  RetrieveComment = "No Comment"
End Function

 

[bkclaw113]

Thanks for the suggestion but I would prefer not to use an error trap to identify if the comment exist. I plan on using this process on worksheets that have a lot of comments (10k +), and I think that the error trap would add extra overhead in the process.


Any other suggestions?

 

[Zathras]

Then do it this way:

Function RetrieveComment(ACell As Range) As String
  If ACell.Comment Is Nothing Then
    RetrieveComment = "No Comment"
  Else
    RetrieveComment = ACell.Comment.Text
  End If
End Function

 

[bkclaw113]

The "is nothing" is exactly what I needed!

Thanks

 

[macropod]

Here's one I wrote (it's even been published!)

Cheers

The following macro adds the formulae to the comments for each selected cell, or even the whole worksheet, and displays the comments in an appropriately-sized box.

Sub AddFormulasToComments()
Application.ScreenUpdating = False
Dim CommentRange As Range, TargetCell As Range
'skip over errors caused by trying to delete comments in cells with no comments
On Error Resume Next
'If the whole worksheet is selected, limit action to the used range.
If Selection.Address = Cells.Address Then
	Set CommentRange = Range(ActiveSheet.UsedRange.Address)
Else
	Set CommentRange = Range(Selection.Address)
End If
'If the cell contains a formula, turn it into a comment.
For Each TargetCell In CommentRange
	With TargetCell
		'check whether the cell has a formula
		If Left(.Formula, 1) = "=" Then
			'delete any existing comment
			.Comment.Delete
			'add a new comment
			.AddComment
			'copy the formula into the comment box
			.Comment.Text Text:=.Formula
			'display the comment
			.Comment.Visible = True
			With .Comment.Shape
				'automatically resizes the comment
				.TextFrame.AutoSize = True
				'position the comment adjacent to its cell
				If TargetCell.Column < 254 Then.IncrementLeft -11.25
				If TargetCell.Row <> 1 Then .IncrementTop 8.25
			End With
		End If
	End With
Next
MsgBox "	To print the comments, choose" & vbCrLf & " File|Page Setup|Sheet|Comments," & vbCrLf & "then choose the required print option.", vbOKOnly
Application.ScreenUpdating = True
End Sub