Announcement

Collapse
No announcement yet.

Transfer Cells Values To Cell Comments

Collapse
This topic is closed.
X
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • Transfer Cells Values To Cell Comments



    Hi all,

    Here is an interesting one.

    I have a report where, month in month out, i have to append columns on the right, to give a Year to date figure. Now there are many rows with different numbers but one of the columns is call [NOTES]. This is where the user can provide commentry on the weekly figures.

    Now whats getting annoying is i have to copy this commentry and then create a comments box then paste the text in there and finally, hide the comment.

    So what i want to be able to do is be able to Copy the cell, then, have a right click menu button saying "Paste As Comment", so it paste the selected cells contents into a comment and hides it.

    Is there something already like this or is it not possible?

    Thanks
    Any help appreciated
    Thank you,


    Error#9

  • #2
    Re: Paste Cells As Comments

    Please test this code on a copy of Your work, just in case. Note only run once or Your end up with multi dup data entrys

    jiuk
    Code:
    Sub jiuk_Them_COMMENTS()
    ' written by: Jack in the UK
    ' Our WEB SIte - www.excel-it.com
    
        Dim myTargetCell_COMMENT As Excel.Range
        Dim myTarget_RANGE As Excel.Range
        Dim myTargetCell_COMMENT_TEXT As String
        
       Set myTarget_RANGE = Range("a1:A10") ' EDIT ****
        For Each myTargetCell_COMMENT In myTarget_RANGE
          If Trim(myTargetCell_COMMENT.Text) <> "" Then
          myTargetCell_COMMENT_TEXT = myTargetCell_COMMENT.Comment.Text
                With myTargetCell_COMMENT
          .Comment.Text myTargetCell_COMMENT_TEXT & vbNewLine & myTargetCell_COMMENT.Value
          .Comment.Visible = False
          .Comment.Shape.TextFrame.AutoSize = True
          End With
          End If
        Next myTargetCell_COMMENT
    theEND:
        Set myTarget_RANGE = Nothing
    End Sub

    Comment


    • #3
      Re: Paste Cells As Comments

      This is bugging on a few things.

      On this line
      Code:
       myTargetCell_COMMENT_TEXT = myTargetCell_COMMENT.Comment.Text
      it says
      Object or with method not found
      Can this run on the cells which has been 'Right Clicked' on?
      Any help appreciated
      Thank you,


      Error#9

      Comment


      • #4
        Re: Paste Cells As Comments

        The code assumes (jiuk assumed) that all cells in range a1 to a10 are populated if not the code bugs. I will try to fix this for You

        No. This code will run on a range not just a one off via right click

        jiuk

        Comment


        • #5
          Re: Paste Cells As Comments

          Ok, well i think will work best is somehow intergrating an
          Code:
          ActiveCell
          so then what i want to do is when i've [CTRL+C] to copy the notes, is there a way to get this code to run of a custom menu on the 'Right Click' Menu, i've heard this can be done??

          Thanks again
          Any help appreciated
          Thank you,


          Error#9

          Comment


          • #6
            Re: Paste Cells As Comments

            I figured that sooner or later I'll have to convert a number of cell values into comments as well, so I went ahead and added it to my personal addin. I also made a separate addin to easily create and destroy the context menus. Just download the attachment to your computer and use Excel's Tools > Add-ins menu to install it.

            Here is the source code, the first bit is the event code that creates and deletes the right-click context menu item when you install or uninstall it:

            Code:
            Option Explicit
            
            Private Const cstrCaption As String = "Paste As Comment"
            Private Const cstrOnAction As String = "PasteAsComment"
            
            Private Sub Workbook_AddinInstall()
            
                Dim cmdNewItem As CommandBarControl
                
                On Error Resume Next
                Application.CommandBars("Cell").Controls(cstrCaption).Delete
                On Error GoTo 0
                
                Set cmdNewItem = Application.CommandBars("Cell").Controls.Add
                
                With cmdNewItem
                    .Caption = cstrCaption
                    .OnAction = cstrOnAction
                    .BeginGroup = True
                End With
            End Sub
            
            Private Sub Workbook_AddinUninstall()
                On Error Resume Next
                Application.CommandBars("Cell").Controls(cstrCaption).Delete
                On Error GoTo 0
            End Sub
            And this bit is the function that takes the cell values and "pastes" them as comments:
            *Updated on 24-08-2007*

            Code:
            Option Explicit
            
            Sub PasteAsComment()
                On Error GoTo PasteAsComment_Error
            
                Dim strClipBoard        As String
                Dim astrClipBoard()     As String
                Dim lngRowCount         As Long
                Dim lngColCount         As Long
                Dim i                   As Long
                Dim rngTarget           As Range
                Dim rngCurrCell         As Range
                Dim objClipBoard        As DataObject
                
                Set objClipBoard = New DataObject
                objClipBoard.GetFromClipboard
                strClipBoard = objClipBoard.GetText
                
                lngRowCount = InstrCount(strClipBoard, Chr(13))
                lngColCount = InstrCount(Left(strClipBoard, InStr(1, strClipBoard, _
                    Chr(13))), Chr(9)) + 1
                
                strClipBoard = Replace(strClipBoard, Chr(10), "")
                strClipBoard = Replace(strClipBoard, Chr(13), ";")
                strClipBoard = Replace(strClipBoard, Chr(9), ";")
                
                astrClipBoard = Split(strClipBoard, ";")
                
                Set rngTarget = Selection.Cells(1).Resize(lngRowCount, lngColCount)
                
                For i = LBound(astrClipBoard) To (UBound(astrClipBoard) - 1)
                    If Len(astrClipBoard(i)) Then
                    
                        Set rngCurrCell = rngTarget.Cells(i + 1)
                        
                        With rngCurrCell
                        
                            If HasComment(rngCurrCell) Then
                                .Comment.Text astrClipBoard(i)
                            Else
                                .AddComment astrClipBoard(i)
                            End If
                            .Comment.Shape.TextFrame.AutoSize = True
                            .Comment.Visible = False
                        End With
                        
                    End If
                Next i
                
                Set objClipBoard = Nothing
                On Error GoTo 0
                Exit Sub
                
            PasteAsComment_Error:
                Set objClipBoard = Nothing
                
                Select Case Err
                Case -2147221404
                    MsgBox "The clipboard is empty, or the data is not text"
                Case Else
                    Err.Raise Err
                End Select
                
            End Sub
            
            Function InstrCount(ByVal strSearchIn As String, _
                       ByVal strFind As String) As Long
                If Not (Len(strSearchIn)) = 0 Then
                    InstrCount = UBound(Split(strSearchIn, strFind))
                End If
            End Function
            
            Function HasComment(ByVal rngCell As Range) As Boolean
                On Error GoTo HasComment_Error
                
                If Not rngCell.Comment.Text = "" Then
                    HasComment = True
                Else
                    HasComment = False
                End If
                
                On Error GoTo 0
                Exit Function
            HasComment_Error:
                HasComment = False
            End Function
            I tried to make it behave like an excel paste. If you copy an area of let's say 3x4 cells and select an area of 2x1 and paste, it will still fill the 3x4 starting from the top left corner of the selected area. What you cannot do is to copy a single cell, and then paste the same comment into multiple cells.

            There isn't much error handling, apart from checking whether the clipboard is empty and that the data is suitable for using as a comment, so I cannot guarantee that there will be no errors.

            Hope this helps,
            Fencliff
            Attached Files
            Last edited by Fencliff; August 24th, 2007, 22:56.

            Comment


            • #7
              Re: Transfer Cells Values To Cell Comments

              OMG!!!!!!!!!
              That is absolute genious!!!
              I didnt have a clue even where to start!
              This is gonna save so much time..

              I wish there was a bit of code i've got to upload to help you guys out but i'm afraid my stuff maybe medioca!

              Again, well done and thank you SO much, this is a happy Error#9....... i love this website.
              Auto Merged Post;

              One quick quick adjustment, how can i get it not to put a comment the the cell in the range is blank, sorry to be a pain
              Last edited by error#9; August 23rd, 2007, 20:42. Reason: Auto Merged Doublepost
              Any help appreciated
              Thank you,


              Error#9

              Comment


              • #8
                Re: Transfer Cells Values To Cell Comments

                Sorry for the delays, this version will be much better. I see You have an XLS for this but jiuk will post for the forum as others might be able to use or look at jiuks work

                jiuk
                Code:
                Sub jiuk_Them_COMMENTS()
                ' written by: Jack in the UK
                ' Our WEB SIte - www.excel-it.com
                     
                Dim myTargetCell_COMMENT As Excel.range
                Dim myTarget_RANGE As Excel.range
                Dim myTargetCell_COMMENT_TEXT As String
                     
                Set myTarget_RANGE = range("a1:a5") ' EDIT ****
                    
                For Each myTargetCell_COMMENT In myTarget_RANGE
                        
                If Test_4_COMMENT(myTargetCell_COMMENT) = False Then
                 myTargetCell_COMMENT.AddComment
                End If
                
                myTargetCell_COMMENT_TEXT = myTargetCell_COMMENT.Comment.Text _
                & vbNewLine & myTargetCell_COMMENT
                       
                With myTargetCell_COMMENT
                .Comment.Visible = False
                .Comment.Shape.TextFrame.AutoSize = True
                .Comment.Text myTargetCell_COMMENT_TEXT
                End With
                        
                    Next myTargetCell_COMMENT
                theEND:
                    Set myTarget_RANGE = Nothing
                End Sub
                Code:
                Function Test_4_COMMENT(TargetRange As range) As Boolean
                ' written by: Jack in the UK
                ' Our WEB Site - www.excel-it.com
                 
                    On Error Resume Next
                    Test_4_COMMENT = _
                     TargetRange.Comment.Parent.Address = TargetRange.Address
                    On Error GoTo 0
                TheEnd_Test_4_COMMENT:
                ' jiuk - do nothinng
                Exit Function
                End Function

                Comment


                • #9
                  Re: Transfer Cells Values To Cell Comments

                  Fencliff and JIUK, Thank you both so much!
                  Fencliff / or anyone in RE to the .xla version, how do i get it NOT to put a comment if there is nothing in the cell, at the moment i need to copy large ranges but there is some blanks, and its creating a comment for a blank!

                  any ideas?
                  Any help appreciated
                  Thank you,


                  Error#9

                  Comment


                  • #10
                    Re: Transfer Cells Values To Cell Comments

                    assuming the notes are stored in columnA, then his code will add the comment from the cell in to he cell that is being updated

                    Option Explicit


                    Code:
                    Private Sub Worksheet_Change(ByVal Target As Range)
                    
                        Dim c      As Range
                        If Target.Column = 1 Then Exit Sub
                            
                            Target.ClearComments
                            Target.AddComment
                            With Target.Comment
                                .Text Cells(Target.Row, 1).Value
                                .Shape.Shadow.Visible = msoFalse
                                .Visible = False
                                .Shape.TextFrame.AutoSize = True
                            End With
                    End Sub
                    Hope that Helps

                    Roy

                    New users should read the Forum Rules before posting

                    For free Excel tools & articles visit my web site

                    RoyUK's Web Site

                    royUK's Database Form

                    Where to paste code from the Forum

                    About me.

                    Comment


                    • #11
                      Re: Transfer Cells Values To Cell Comments

                      Originally posted by error#9
                      Fencliff and JIUK, Thank you both so much!
                      Fencliff / or anyone in RE to the .xla version, how do i get it NOT to put a comment if there is nothing in the cell, at the moment i need to copy large ranges but there is some blanks, and its creating a comment for a blank!

                      any ideas?
                      I updated the code in my previous post, and also updated the attachment. Now it does not create empty comments and if cell already has a comment, it replaces it.

                      You can either uninstall the addin, load the attachment and reinstall it, or easier, replace all the code in the module modPasteAsComment with the updated code above.

                      Comment


                      • #12
                        Re: Transfer Cells Values To Cell Comments

                        For those wondering, I checked this and it works perfectly under Excel 2010. Adding add-ins, though, is a bit hidden in this version:

                        1. Click the File tab, click Options, and then click the Add-Ins category.
                        2. In the Manage box, click Excel Add-ins, and then click Go. The Add-Ins dialog box appears.
                        3. In the Add-Ins available box, click Browse... and select the downloaded .xla file. The checkbox appears activated automatically; if not, enable it and click ok.

                        Comment


                        • #13
                          Re: Transfer Cells Values To Cell Comments

                          Thanks for that!!!! Saved me a ton of time today.

                          One comment to add: If your source cells contain a semicolon the comments will not paste to the correct cells. The code interprets the semicolon and drops the remaining part of the cell to the next row. Not sure if that makes sense the way I explained it, but when I replaced the semicolons with dashes it worked as expected.

                          Comment


                          • #14
                            Can anybody adjust Fencliff's code to work inside a table? It works great but not inside an area with table properties. Its doesn't give me the "Paste As Comment" option when I right click inside the table.

                            Comment


                            • #15


                              A quick fix to make it work only inside tables is to replace "Cell" with "List Range Popup" in the Sub Workbook_AddinInstall

                              Code:
                              Set cmdNewItem = Application.CommandBars("Cell").Controls.Add
                              I've adopted Fencliff's code to add an option to copy a range of cells values into a single comment.
                              Not so pretty, but it works.

                              Code:
                              Option Explicit
                              Private Const cstrCaption1 As String = "Paste As Comment(s)"
                              Private Const cstrOnAction1 As String = "PasteAsComment"
                              
                              Private Const cstrCaption2 As String = "Paste As Single Comment"
                              Private Const cstrOnAction2 As String = "PasteAsSingleComment"
                              
                              Private Sub Workbook_AddinInstall()
                              
                                  Dim cmdNewItem As CommandBarControl
                                  
                                  On Error Resume Next
                                  Application.CommandBars("Cell").Controls(cstrCaption1).Delete
                                  Application.CommandBars("Cell").Controls(cstrCaption2).Delete
                                  On Error GoTo 0
                                  
                                  '--- Paste As Comment(s) ---
                                  ' In CELL
                                  Set cmdNewItem = Application.CommandBars("Cell").Controls.Add
                                  With cmdNewItem
                                      .Caption = cstrCaption1
                                      .OnAction = cstrOnAction1
                                      .FaceId = 1548
                                      .TooltipText = "Pastes copied cells to multiple cells comments"
                                      .BeginGroup = True
                                  End With
                                  ' In TABLE
                                  Set cmdNewItem = Application.CommandBars("List Range Popup").Controls.Add
                                  With cmdNewItem
                                      .Caption = cstrCaption1
                                      .OnAction = cstrOnAction1
                                      .FaceId = 1548
                                      .TooltipText = "Pastes copied cells to multiple cells comments"
                                      .BeginGroup = True
                                  End With
                                  
                                  '--- Paste As Single Comment ---
                                  ' In CELL
                                  Set cmdNewItem = Application.CommandBars("Cell").Controls.Add
                                  With cmdNewItem
                                      .Caption = cstrCaption2
                                      .OnAction = cstrOnAction2
                                      .FaceId = 1547
                                      .TooltipText = "Pastes copied cells to single cell comment"
                                  End With
                                  ' In TABLE
                                  Set cmdNewItem = Application.CommandBars("List Range Popup").Controls.Add
                                  With cmdNewItem
                                      .Caption = cstrCaption2
                                      .OnAction = cstrOnAction2
                                      .FaceId = 1547
                                      .TooltipText = "Pastes copied cells to single cell comment"
                                  End With
                              
                              End Sub
                              
                              Private Sub Workbook_AddinUninstall()
                                  On Error Resume Next
                                  
                                  Application.CommandBars("Cell").Controls(cstrCaption1).Delete
                                  Application.CommandBars("List Range Popup").Controls(cstrCaption1).Delete
                                  
                                  Application.CommandBars("Cell").Controls(cstrCaption2).Delete
                                  Application.CommandBars("List Range Popup").Controls(cstrCaption2).Delete
                                  
                                  On Error GoTo 0
                              End Sub
                              (The TooltipText isn't functioning correctly.)

                              For this to work, you also have to add the sub PasteAsSingleComment:
                              Code:
                              Sub PasteAsSingleComment()
                                  On Error GoTo PasteAsSingleComment_Error
                              
                                  Dim strClipBoard        As String
                                  Dim astrClipBoard()     As String
                                  Dim lngRowCount         As Long
                                  Dim lngColCount         As Long
                                  Dim i                   As Long
                                  Dim rngTarget           As Range
                                  Dim rngCurrCell         As Range
                                  Dim objClipBoard        As DataObject
                                  
                                  Set objClipBoard = New DataObject
                                  objClipBoard.GetFromClipboard
                                  strClipBoard = objClipBoard.GetText
                                  
                                  strClipBoard = Replace(strClipBoard, Chr(10), vbLf)   'Chr(10) - new line
                                  strClipBoard = Replace(strClipBoard, Chr(13), vbCr)   'Chr(13) - carriage return
                                  strClipBoard = Replace(strClipBoard, Chr(9), "    ")  'Chr(9)  - horizontal tab
                                  
                                  Set rngTarget = Selection.Cells(1)
                                  
                                  With rngTarget
                                      If HasComment(rngTarget) Then
                                          .Comment.Text strClipBoard
                                      Else
                                          .AddComment strClipBoard
                                      End If
                                      .Comment.Shape.TextFrame.AutoSize = True
                                      .Comment.Visible = False
                                  End With
                                  
                                  Set objClipBoard = Nothing
                                  On Error GoTo 0
                                  Exit Sub
                                  
                              PasteAsSingleComment_Error:
                                  Set objClipBoard = Nothing
                                  
                                  Select Case Err
                                  Case -2147221404
                                      MsgBox "The clipboard is empty, or the data is not text"
                                  Case Else
                                      Err.Raise Err
                                  End Select
                                  
                              End Sub

                              Comment

                              Working...
                              X