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

 

[MeaclH]

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

Hey there, I am getting an invariable block error when I've made this change?
Any ideas ?
Cheers
Hayden

 

[StephenCrump]

Can you please post the code you're using, and let us know which line produces the error? Thanks.

 

[MeaclH]

Can you please post the code you're using, and let us know which line produces the error? Thanks.

Hi Stephen,

I amended the code to look like this. I am a complete noob so this has been pieced together from other projects/helping hands.

The error I got was "Object variable or with block variable not set"

Appreicate your help!
Hayden

Sub ConfirmShift()
       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
                S = .Comment.Text
                ActiveSheet.Unprotect
                .ClearComments
                .AddComment
                .Comment.Text Text:=sCmt & Chr(10) & S
            End With
        Next
    End If
    Set rCell = Nothing
Selection.Interior.Color = RGB(215, 245, 215)
ActiveSheet.Protect DrawingObjects:=False
End Sub

 

[StephenCrump]

This is the problem line. It will error if .Comment is Nothing

S = .Comment.Text

Here's one way you could write your code:

Sub ConfirmShift()
    
    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."
        Exit Sub 'user cancelled inputbox / entered blank
    Else
        ActiveSheet.Unprotect
        For Each rCell In Selection
            With rCell
                If .Comment Is Nothing Then
                    .AddComment.Text sCmt
                Else
                    .Comment.Text sCmt & Chr(10) & .Comment.Text
                End If
            End With
        Next
        Set rCell = Nothing
        Selection.Interior.Color = RGB(215, 245, 215)
        ActiveSheet.Protect
    End If

End Sub

 

[MeaclH]

Stephen this is sensational, thank you mate

This is the problem line. It will error if .Comment is Nothing

S = .Comment.Text

Here's one way you could write your code:

Sub ConfirmShift()
   
    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."
        Exit Sub 'user cancelled inputbox / entered blank
    Else
        ActiveSheet.Unprotect
        For Each rCell In Selection
            With rCell
                If .Comment Is Nothing Then
                    .AddComment.Text sCmt
                Else
                    .Comment.Text sCmt & Chr(10) & .Comment.Text
                End If
            End With
        Next
        Set rCell = Nothing
        Selection.Interior.Color = RGB(215, 245, 215)
        ActiveSheet.Protect
    End If

End Sub