Formatting comments with VBA

[jmpatrick]

Good morning!

I have some code that creates a comment in the selected cell based on the username and date.

Sub AddComment()

Application.ScreenUpdating = False

ActiveCell.FormulaR1C1 = "'" & Format(Now, "m/dd")
  
    Dim vCellValue As Variant
    Dim sText As String
  
    vCellValue = ActiveCell.Value
    If IsNumeric(vCellValue) Then
        vCellValue = CDbl(vCellValue)
    End If
      
    sText = Application.UserName & ":" & vbCrLf
    sText = sText & "Sent to cc on" & vbCrLf
    sText = sText & Format(Now, "M/DD/YY H:MM AM/PM")
  
    With ActiveCell
        .ClearComments
        With .AddComment
            .Text sText
            With .Shape
                .TextFrame.Characters(1, InStr(sText, ":")).Font.Bold = msoTrue
                .Width = 180
                .Height = 60

            End With
        End With
    End With
     
    Application.ScreenUpdating = True
  
End Sub

Here's some code I have that formats comments on the entire worksheet. Can I apply this functionality to the code above so that it only formats the comment in the current cell and not the whole sheet?

Sub CommentFormat()
Application.ScreenUpdating = False
Dim xWs As Worksheet
Dim xComment As Comment
For Each xWs In Application.ActiveWorkbook.Worksheets
    For Each xComment In xWs.Comments
        With xComment.Shape.TextFrame.Characters.Font
            .Name = "Tahoma"
            .Size = 12
        End With
        With xComment.Shape.TextFrame
            .AutoSize = True
        End With
    Next
Next
Application.ScreenUpdating = True
End Sub

 

[Fluff]

How about

Sub AddComment()

Application.ScreenUpdating = False

ActiveCell.FormulaR1C1 = "'" & Format(Now, "m/dd")
  
    Dim vCellValue As Variant
    Dim sText As String
  
    vCellValue = ActiveCell.Value
    If IsNumeric(vCellValue) Then
        vCellValue = CDbl(vCellValue)
    End If
      
    sText = Application.UserName & ":" & vbCrLf
    sText = sText & "Sent to cc on" & vbCrLf
    sText = sText & Format(Now, "M/DD/YY H:MM AM/PM")
  
    With ActiveCell
        .ClearComments
        With .AddComment
            .Text sText
            With .Shape
                .TextFrame.Characters(1, InStr(sText, ":")).Font.Bold = True
                .Width = 180
                .Height = 60
                With .TextFrame.Characters.Font
                   .Name = "Tahoma"
                   .Size = 12
                End With
                With .TextFrame
                   .AutoSize = True
                End With
            End With
        End With
    End With
     
    Application.ScreenUpdating = True
  
End Sub

 

[jmpatrick]

How about

Sub AddComment()

Application.ScreenUpdating = False

ActiveCell.FormulaR1C1 = "'" & Format(Now, "m/dd")
 
    Dim vCellValue As Variant
    Dim sText As String
 
    vCellValue = ActiveCell.Value
    If IsNumeric(vCellValue) Then
        vCellValue = CDbl(vCellValue)
    End If
     
    sText = Application.UserName & ":" & vbCrLf
    sText = sText & "Sent to cc on" & vbCrLf
    sText = sText & Format(Now, "M/DD/YY H:MM AM/PM")
 
    With ActiveCell
        .ClearComments
        With .AddComment
            .Text sText
            With .Shape
                .TextFrame.Characters(1, InStr(sText, ":")).Font.Bold = True
                .Width = 180
                .Height = 60
                With .TextFrame.Characters.Font
                   .Name = "Tahoma"
                   .Size = 12
                End With
                With .TextFrame
                   .AutoSize = True
                End With
            End With
        End With
    End With
    
    Application.ScreenUpdating = True
 
End Sub

Perfect! Thanks.

 

[Fluff]

You're welcome & thanks for the feedback.