A macro to link a comment with the contents of a cell

[Discipulus]

Hi there,

I've got an excel spreadsheet with 2 tabs. The first tab is a dashboard, which basically has a map of a storage yard with all the different container units.

The second tab contains all the data. i.e. the customers name, mobile number, date due and etc.

I'm looking for a way to show a summary of information about a customer when you hover over a cell. E.g. in the dashboard tab if I hover over cell A17 (which refers to say container 21) then I would want a comment to appear which has the following info:

Customer name: ....
Customer Mobile #:
Due Date: .....

So this comment box would need to be linked with my second tab i.e. the tab with all the data. It would need to be linked with the cell contents and the comment box in the dashboard would need to update whenever changes are made to this data.

I hope this makes sense. I would appreciate any assistance

Thanks,

Dan

 

[L. Howard]

Hi Dan,

Give this a try. Copy to a test sheet module, change the sheet names in the code to match yours.
Where here, I have the code in sheet 3 module and the comment text link cells are on sheet 4, in A1 & A2.

The range for comments on sheet 3, is B1:B20, and the code will do comments in B1 and B2, with the two Cases in the Select Case function. To do any number of cells requires a Case = Range($?$?) and follow the code schematic for each additional case.

If a cell already has a comment, then it is deleted and a new comment will replace it. This will take care of updates to the data link cells on sheet 4.

If there is no comment in the cell selected, then the code installs one with the current sheet 4 link cell info.

In the link cells, I used Alt + Enter for each line of data in the cell. That will give you something like:

My Name
My ID Number
This line of info
This line of info

And that is what it will look like in the comment box pop-up.

Howard

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim MyCells As Range
    Set MyCells = Range("B1:B20") '/ Cells 1 TO 20 only
    
    If Not Application.Intersect(MyCells, Range(Target.Address)) _
                       Is Nothing Then
           
        Select Case Target
        
          Case Is = Range("$B$1")
          
              If Cells(1, 2).Comment Is Nothing Then
                  'no comment, so add one
                 Cells(1, 2).AddComment Sheets("Sheet4").Cells(1, 1).Text
                Else
                  'already comment, so delete then add
                 Cells(1, 2).Comment.Delete
                 Cells(1, 2).AddComment Sheets("Sheet4").Cells(1, 1).Text
              End If
          
         Case Is = Range("$B$2")
         
              If Cells(2, 2).Comment Is Nothing Then
                  'no comment, so add one
                 Cells(2, 2).AddComment Sheets("Sheet4").Cells(2, 1).Text
                Else
                  'already comment, so delete then add
                 Cells(2, 2).Comment.Delete
                 Cells(2, 2).AddComment Sheets("Sheet4").Cells(2, 1).Text
              End If
          
           
        End Select
 
   End If
   
End Sub

 

[Discipulus]

Hi Howard,

I really appreciate your response.

I'm fairly new to using macros so please bare with me I can't seem to get the macro to run. Normally after putting the code in a module, the macro then appears in the list of macros and I can run it. That doesn't seem to be the case here. Any ideas?

If possible could you provide the code within an excel spreadsheet as an example. That would be really useful for me to understand how its working.

Thanks,

Dan

 

[L. Howard]

Hi Dan,

Sure, first there is no "hover" aspect with my approach.

The code is an Event macro that requires a certain action or event to occur. In this case that action is simply Selecting a cell, hence the name Worksheet_SelectionChange. The action was, you changed the cell selection on your worksheet, and when this cell is selected you want something to happen.

Event macros are placed in the sheet modules of the sheet where the event will take place. Or in the ThisWorkbook for certain other event macros.

There are many different events macro names available...

Worksheet_Change
Worksheet_BeforeDoubleClick
Workbook_Open
Workbook_SheetCalculate

...to name a few.

These will not show up on the lists you mention because you don't assign them to buttons or shapes or Key-Stroke-Short-Cuts to make them run. These code just lurk in their proper places awaiting for their event to happen, then spring into action when needed.

Also, they may spring into action when or where you don't want them. So you may need to limit the action to certain cells, or ranges. Which is what I did here, range B1:B20 are the only cells the code will run on, and only if that event actually occurred to that range. So with the Worksheet_SelectionChange, the mere fact that you selected a cell in that range evokes the macros action.

    Set MyCells = Range("B1:B20") '/ Cells 1 TO 20 only
    
    If Not Application.Intersect(MyCells, Range(Target.Address)) _
                       Is Nothing Then

I'll put together a sheet to demo and post a link to it here.

FYI, you cannot attach or post a workbook to this forum, links only, and many forum users shun links for all the good reasons.

Howard

 

[L. Howard]

Hi Dan,

Give this a go. Instructions are on the sheets.

Only codes are in Sheet 1 module. Feel free to ask if you need some help understanding what's going on or need something else done.

https://www.dropbox.com/s/ou3wtt04n1mw48x/EVENT Macro Demo Drop Box.xlsm?dl=0

Howard

Here are the codes.

Option Explicit


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    On Error GoTo Whoa

    Application.EnableEvents = False

    If Not Intersect(Target, Range("B2")) Is Nothing Then
         If Target.Comment Is Nothing Then
            'no comment, so add one
            Target.AddComment Sheets("Sheet2").Cells(2, 4).Text
            Target.Comment.Shape.TextFrame.AutoSize = True
          Else
            'already comment, so delete then add
            Target.Comment.Delete
            Target.AddComment Sheets("Sheet2").Cells(2, 4).Text
            Target.Comment.Shape.TextFrame.AutoSize = True
         End If
         
       ElseIf Not Intersect(Target, Range("B3")) Is Nothing Then
         If Target.Comment Is Nothing Then
            Target.AddComment Sheets("Sheet2").Cells(3, 4).Text
            Target.Comment.Shape.TextFrame.AutoSize = True
          Else
            Target.Comment.Delete
            Target.AddComment Sheets("Sheet2").Cells(3, 4).Text
            Target.Comment.Shape.TextFrame.AutoSize = True
         End If
         
       ElseIf Not Intersect(Target, Range("B4")) Is Nothing Then
         If Target.Comment Is Nothing Then
            Target.AddComment Sheets("Sheet2").Cells(4, 4).Text
            Target.Comment.Shape.TextFrame.AutoSize = True
          Else
            Target.Comment.Delete
            Target.AddComment Sheets("Sheet2").Cells(4, 4).Text
            Target.Comment.Shape.TextFrame.AutoSize = True
         End If
    
       ElseIf Not Intersect(Target, Range("B5")) Is Nothing Then
         If Target.Comment Is Nothing Then
            Target.AddComment Sheets("Sheet2").Cells(5, 4).Text
            Target.Comment.Shape.TextFrame.AutoSize = True
          Else
            Target.Comment.Delete
            Target.AddComment Sheets("Sheet2").Cells(5, 4).Text
            Target.Comment.Shape.TextFrame.AutoSize = True
         End If
    
       ElseIf Not Intersect(Target, Range("B6")) Is Nothing Then
         If Target.Comment Is Nothing Then
            Target.AddComment Sheets("Sheet2").Cells(6, 4).Text
            Target.Comment.Shape.TextFrame.AutoSize = True
          Else
            Target.Comment.Delete
            Target.AddComment Sheets("Sheet2").Cells(6, 4).Text
            Target.Comment.Shape.TextFrame.AutoSize = True
         End If
    
    End If

Letscontinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume Letscontinue

   
End Sub


Sub Delets_Comments()

Dim OneRng As Range, c As Range
Dim LRow As Long

LRow = Sheets("Sheet2").Cells(Rows.Count, "D").End(xlUp).Row

Set OneRng = Range("B2:B" & LRow)

With OneRng

     .ClearComments
End With

End Sub

Sub Add_Update__Comments()

Dim OneRng As Range, c As Range
Dim myRows As Long

myRows = Sheets("Sheet2").Cells(Rows.Count, "D").End(xlUp).Row

Set OneRng = Range("B2:B" & myRows)

 For Each c In OneRng
 
     c.Select
   
 Next
     
End Sub

 

[Discipulus]

This is great Howard. I've had a play about with the coding you've provided and I understand this much better now. I'm thinking that this will be a bit more complex then i originally thought. This might be a bit cheeky but are you able to take a look at the spreadsheet I am working with?

https://www.dropbox.com/s/xm1nqqvu0y5luca/CRM Overview.xlsm?dl=0

If you look at the Dashboard tab, what I'm looking to do is to have a comment for all of these units- thats over 370 units. Each comment would capture the corresponding information for that unit in the 'CRM Overview' tab. So for Box 1 the comment would show:

Name: John Smith (i.e. from column c)
Mobile number: 08000000000 (column d)
Due Date: n/a (column e)
Status: (column k)

Is there anyway of doing this efficiently for all 370+ units? Additionally, rather than using the 'Worksheet_SelectionChange' is it possible to have the comments update when the code detects that the linked data has been changed. The reason is that these cells are hyperlinked in the dashboard so clicking on them is quite annoying.

Thanks a lot for your quick responses

Dan

 

[L. Howard]

I'll see what I can do.

Howard

 

[Discipulus]

Thanks Howard- I appreciate it.

Dan

 

[L. Howard]

Hi Dan,

I was unable to write a proper code myself so I got some great help from Claus @ MS Public, who is the author of the comment producing code running on your downloaded workbook.

On the Dashboard sheet in the vicinity of cells V2 & W2 are two shapes that run the main comment producing code, the GOLD STAR, and the clear comments RED CIRCLE SLASH, that deletes all comments on Dashboard.

The delete does just that, deletes all comments, nothing more.

The Gold Star first deletes previous comments, then re-establishes them with the current data from CRM Overview sheet. 380 comments takes about 5 seconds.

On the CRM Overview sheet, I wrote a sheet_change macro where columns C, D, E & K are monitored for any changes. If a change occurs in any of those columns cells, you will get an Alert box notifying you a change has been made and to what cell it was made. Your options are to click Yes and all comments are updated with the change, OR you can click no to Wait, perhaps you want to make several changes and update after all changes are completed. On the last change, you would click Yes, and the updates will include all changes to the comments.

On a side note, I would encourage you to forgo MERGED cells and use Format > Cells > Alignment > Center Across Selection. Merged cells are generally bad idea. You used them for a "look pretty" scheme on Dashboard, and they were not a problem. Over on CRN Overview you could have some trouble.

Also on the CRM Ov sheet, I was required to delete column 11 (K) and re-establish it for the code to pick up any status data for the comments. On a later download, the one you will get back in the link below, I selected the entire column and deleted the cells - shift upwards. Then entered status data, worked fine, and seems to be okay now.

Give a try and let me know if any problems.

Howard

https://www.dropbox.com/s/3u2fc4gtj21lqyq/CRN Overview Comments Drop Box.xlsm?dl=0


The codes:

In Overview sheet module.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim MyCells As Range
    
    Set MyCells = Range("C1:C386,D1:D386,E1:E386,K1:K386")
    
    If Not Application.Intersect(MyCells, Range(Target.Address)) _
           Is Nothing Then
        
        Beep
      
     Dim Reply As VbMsgBoxResult
     Reply = MsgBox("             The Value in range " & Target.Address & " has changed." _
          & vbCr & "Do you want to update DASHBOARD comment boxes?" _
          & vbCr & vbCr & "                 Yes to UPDATE,  No to WAIT", _
           vbYesNo + vbQuestion, "Name the Alert Box here!")
  
       If Reply = vbNo Then Exit Sub
  
           ' A Yes click
           MsgBox "UPDATING" _
             & vbCr & "" _
             & vbCr & ""
           CMT_Maker_Update
             Beep
             MsgBox "UPDATING is complete."
    End If
End Sub

In Module 1.

Option Explicit

Sub CMT_Maker1()
'/ run from Dashboard gold star

Dim myRng As Range, c As Range
Dim LRow As Long, i As Long, n As Long
Dim varSearch As Variant, varOut(3) As Variant, varCols As Variant
Dim myStr As String

Set myRng = Sheets("Dashboard").Range("A1:S40")
myRng.ClearComments
varCols = Array(3, 4, 5, 11)

With Sheets("CRM Overview")
    LRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    varSearch = .Range("A2:A" & LRow)
    For i = LBound(varSearch) To UBound(varSearch)
        Set c = myRng.Find(varSearch(i, 1), LookIn:=xlValues, lookat:=xlWhole)
        If Not c Is Nothing Then
            myStr = ""
            'string is created cell by cell looping through varcols
            For n = LBound(varCols) To UBound(varCols)
                myStr = myStr & Chr(10) & .Cells(i + 1, varCols(n))
            Next
            c.AddComment Mid(myStr, 2)
        End If
    Next
End With

Beep
MsgBox "Comments complete"

[U10].Select
End Sub

 

[Discipulus]

Hi Howard,

This code is amazing- it works great. I've tested it quite extensively and its working better than I imagined. I really do appreciate the help both you and Claus have provided.

Thank you so much

Dan