Option Explicit 
 
Sub FormulasInComment() 
    Const CmtString As String = "Formula is:" 
    Dim r As Range 
    Dim MyRange As Range 
    Dim MyComment 
     
     '   Prompt to run procedure (yes/no)
    If MsgBox("Find all formula cells by adding a comment?" & vbCr & _ 
    "You will be prompted if you want to overwrite previous comments" & vbCr & _ 
    "ALL comments NOT in formula cells will be left intact" _ 
    , vbYesNo, "Comments") = vbNo Then Exit Sub 
     
     '   Specify the range
    Set MyRange = ActiveSheet.UsedRange 
     
     '   Clear previous formula comments
     '   Only clear formula comments other than this procedure by prompt
     '   Leave all other comments intact
    On Error Resume Next 
    For Each r In MyRange 
        If Left(r.Comment.Text, 11) = CmtString And Not (r.HasFormula) Then 
            r.ClearComments 
        End If 
        If Left(r.Comment.Text, 11) <> CmtString And r.HasFormula Then 
            r.Select 
            If MsgBox("The comment in Cell " & r.Address(0, 0) & vbCr & _ 
            "Contains the text:" & vbCr & _ 
            "" & r.Comment.Text & "" & vbCr & vbCr & "Overwrite this comment?", _ 
            vbYesNo) = vbYes Then 
                r.ClearComments 
            End If 
        End If 
    Next r 
     '   Now add comments to cells containing formulas
     '   Display the formula in the comment
    For Each r In MyRange 
         '       Check for comment
        MyComment = r.Comment.Text 
        If r.HasFormula = True And IsEmpty(MyComment) Then 
            r.AddComment "Formula is: " & r.Formula 
             '           Autosize and format
            With r.Comment.Shape 
                .TextFrame.AutoSize = True 
                .AutoShapeType = msoShapeRoundedRectangle 
                .Shadow.Type = msoShadow12 
                .Line.Weight = 1# 
            End With 
             '           Set comment to indicator only
            r.Comment.Visible = False 
        End If 
         '       Clear for next test
        MyComment = Nothing 
    Next r 
     '   Clear memory
    Set MyRange = Nothing 
End Sub