Bdtjtk

I have an excel sheet with a column of cells which each contain very long comments - and I dont want to widen the width of the cells as it will be too wide and the contents will only be viewed occasionally. The contents of each cell is dynamic, being pulled in from an external data source, and so can change from time to time.

What I'd like to do is be able to hover over the cell, and then have its entire contents show up as a tooltip or comment, but disappear when not hovering over it.

(I know I could set them up as Data validation, but since the content is dynamic this wont work).

I was wondering if its possible to do this? And also, my VBA skills are quite primitive, so if someone does happen to be able to help, would you be able to tell me exactly where to insert the VBA code and how to make it "work"!

Thanks in advance, if anyone is able to help.
Brian

my VBA skills are quite primitive, so if someone does happen to be able to help, would you be able to tell me exactly where to insert the VBA code and how to make it "work"!

I usually do not answer questions which lack efforts but this question is way beyond a normal question so I am going to attempt to answer it.

It is possible to show the contents when hovering over a cell. When I say hovering, I mean hovering and not Selecting a cell.

The link to the sample file is posted at the end of this post.

1. In your file, go to the VBA editor and insert a userform. Next place a label control and resize it to fill the userform as shown in the image below

2. Paste this code in the userform

Code

Option Explicit



Const GWL_STYLE = -16

Const WS_CAPTION = &HC00000



Private Declare Function GetWindowLong _

Lib "user32" Alias "GetWindowLongA" ( _

ByVal hWnd As Long, ByVal nIndex As Long) As Long



Private Declare Function SetWindowLong _

Lib "user32" Alias "SetWindowLongA" ( _

ByVal hWnd As Long, ByVal nIndex As Long, _

ByVal dwNewLong As Long) As Long



Private Declare Function DrawMenuBar _

Lib "user32" (ByVal hWnd As Long) As Long



Private Declare Function FindWindowA _

Lib "user32" (ByVal lpClassName As String, _

ByVal lpWindowName As String) As Long



Sub HideTitleBar(frm As Object)

    Dim lngWindow As Long

    Dim lFrmHdl As Long

    lFrmHdl = FindWindowA(vbNullString, frm.Caption)

    lngWindow = GetWindowLong(lFrmHdl, GWL_STYLE)

    lngWindow = lngWindow And (Not WS_CAPTION)

    Call SetWindowLong(lFrmHdl, GWL_STYLE, lngWindow)

    Call DrawMenuBar(lFrmHdl)

End Sub



'~~> Hide Title bar and border using API    

Private Sub UserForm_Initialize()

    HideTitleBar UserForm1

End Sub



'~~> Stop the execution of the code

Private Sub Label1_Click()

    StopLoop = True

    Unload Me

End Sub

What this does is that it removes the title bar and the border of the form.

3. Next insert a Module and paste this code there

Public Declare Function GetCursorPos Lib "user32" _

(lpPoint As POINTAPI) As Long



Public Type POINTAPI

    x As Long

    y As Long

End Type



Public StopLoop As Boolean



Sub StartShowingCellContents()

    Dim lngCurPos As POINTAPI

    Dim rng As Range



    StopLoop = False



    Do

        '~~> Get the cursor position

        GetCursorPos lngCurPos



        '~~> This will give the cell address "under" the cursor

        Set rng = ActiveWindow.RangeFromPoint(lngCurPos.x, lngCurPos.y)



        If Not rng Is Nothing Then

            If Not rng.Cells.CountLarge > 1 Then

                With UserForm1

                    '~~> Display cell value in the label

                    .Label1.Caption = rng.Value

                    '~~> Show the form modeless

                    .Show vbModeless

                    DoEvents

                End With

            End If

        End If



        DoEvents



        '~~> Stop the loop (invoked by clicking on the userform's label

        If StopLoop = True Then Exit Sub

    Loop

End Sub

4. And you are done. To start, run the procedure Sub StartShowingCellContents(). And to stop, simply click on the userform

5. In action. I clicked the image using a phone so that you could see the cursor on top of that cell.

IMPORTANT:

1. You will not be able to perform any operations like copy, paste, delete etc till the time the code is running. Stop the code, do what you want and then run the code again.


2. Feel free to customize the code to your liking.


3. Sample file can be downloaded from HERE
   

Something like this should work, the only item I still need to resolve is to autosize the comment window. The default autosize doesn't do a great job, so I made the sizing static. This only works if you click the cell, so I should point that out.

Add this code to the code behind of the ThisWorkbook object and this will work for all worksheets in a workbook. If you want this only for one sheet, add it to the Worksheet_SelectionChange section behind the Worksheet(s) of interest.

Private LastTarget As Range



Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

    On Error Resume Next

    If Not LastTarget Is Nothing Then

        If Not LastTarget.Comment Is Nothing Then LastTarget.Comment.Delete

    End If



    If Not Trim$(Target.Value) = vbNullString Then

        If Target.Comment Is Nothing Then

            Target.AddComment Target.Text

            Target.Comment.Visible = True

            Target.Comment.Shape.Width = 300 'Change as needed

            Target.Comment.Shape.Height = 300 'Change as needed

            Target.Comment.Shape.Fill.Transparency = 0.6 'Make the comment a little see through

        End If

    End If



    Set LastTarget = Target

End Sub