Stack comments with VBA instead of clear and overwrite

[MeaclH]

Hi all,

Just need some quick help with a couple of codes I have working almost perfectly.
I need comments to stack or add to any comment already in the target cell.
I have tried removing the line of code .ClearComments without any luck. I get a 400 error upon running it.
Any ideas on a solution?

Many thanks in advance.

Sub swaptosameplace()
    Dim sCmt As String
    Dim i As Long
    Dim rCell As Range
    Dim area1 As Variant, area2 As Variant, swapval As Variant
    
    sCmt = InputBox( _
      Prompt:="Enter details of the swap. Including when it was actioned and by who." & vbCrLf & _
      "Comment will be added to all cells in Selection", _
      Title:="DAO Swap Details")
    If sCmt = "" Then
        MsgBox "No comment added"
    Else
        For Each rCell In Selection
            With rCell
                .ClearComments
                .AddComment
                .Comment.Text Text:=sCmt
            End With
        Next
    End If
    Set rCell = Nothing
    If Selection.Areas.Count <> 2 Then Exit Sub
    If Selection.Areas(1).Columns.Count <> Selection.Areas(2).Columns.Count Then
        MsgBox ("Selection areas must have the same number of columns")
        Exit Sub
    End If
    area1 = Selection.Areas(1)
    area2 = Selection.Areas(2)
    If Selection.Areas(1).Columns.Count = 1 Then
        swapval = area1
        area1 = area2
        area2 = swapval
    Else
        For i = LBound(area1, 2) To UBound(area1, 2)
            swapval = area1(1, i)
            area1(1, i) = area2(1, i)
            area2(1, i) = swapval
        Next
    End If
    Selection.Areas(1) = area1
    Selection.Areas(2) = area2
    
End Sub

 

[StephenCrump]

Like this perhaps?

For Each rCell In Selection
    With rCell
        If .Comment Is Nothing Then
            .AddComment.Text sCmt
        Else
            .Comment.Text sCmt & vbLf & .Comment.Text
        End If
    End With
Next

 

[MeaclH]

Like this perhaps?

For Each rCell In Selection
    With rCell
        If .Comment Is Nothing Then
            .AddComment.Text sCmt
        Else
            .Comment.Text sCmt & vbLf & .Comment.Text
        End If
    End With
Next

Thats amazing thanks mate.
What about this one? Probably a simple fix but I'm really a novice
Thanks again
H

Sub ConfirmExt_click()
       Dim sCmt As String
    Dim rCell As Range

    sCmt = InputBox( _
      Prompt:="Have you confirmed this extra shift with the DAO?" & vbCrLf & _
      "Please add your name, date and time this was confirmed. ", _
      Title:="Comment to Add")
    If sCmt = "" Then
        MsgBox "Shift remains unconfirmed. Please notify DAO or seek alternative."
    If StrPtr(sCmt) = 0 Then Exit Sub 'user cancelled inputbox
    
    Else
        For Each rCell In Selection
            With rCell
                .ClearComments
                .AddComment
                .Comment.Text Text:=sCmt
            End With
        Next
    End If
    Set rCell = Nothing
Selection.Interior.Color = RGB(215, 245, 215)
End Sub

 

[kvsrinivasamurthy]

Change This

 With rCell
                .ClearComments
                .AddComment
                .Comment.Text Text:=sCmt
            End With

as
Declare S as string

 With rCell
 S = .Comment.Text
      .ClearComments
      .AddComment
      .Comment.Text Text:=sCmt & Chr(10) & S
 End With