Stack comments with VBA instead of clear and overwrite

MeaclH

Board Regular
Joined
Apr 2, 2014
Messages
86
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
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.

VBA Code:
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
 

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.
Like this perhaps?

VBA Code:
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
 
Upvote 0
Like this perhaps?

VBA Code:
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

VBA Code:
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
 
Upvote 0
Change This
VBA Code:
 With rCell
                .ClearComments
                .AddComment
                .Comment.Text Text:=sCmt
            End With
as
Declare S as string
VBA Code:
 With rCell
 S = .Comment.Text
      .ClearComments
      .AddComment
      .Comment.Text Text:=sCmt & Chr(10) & S
 End With
 
Upvote 0
Change This
VBA Code:
 With rCell
                .ClearComments
                .AddComment
                .Comment.Text Text:=sCmt
            End With
as
Declare S as string
VBA Code:
 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
 
Upvote 0
Can you please post the code you're using, and let us know which line produces the error? Thanks.
 
Upvote 0
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

VBA 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."
    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
 
Upvote 0
This is the problem line. It will error if .Comment is Nothing

VBA Code:
S = .Comment.Text

Here's one way you could write your code:

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
 
Upvote 0
Solution
Stephen this is sensational, thank you mate
This is the problem line. It will error if .Comment is Nothing

VBA Code:
S = .Comment.Text

Here's one way you could write your code:

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
 
Upvote 0

Forum statistics

Threads
1,224,245
Messages
6,177,395
Members
452,773
Latest member
D P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top