Excel: Auto tool tips

Handy Hint: If you do not need the tooltips to be dynamic, or you do not wish to destroy existing comments, then follow Excel: Add comments to a range of cells – simply choose the same source and destination cells to create tooltips for truncated cells.

Excel is not very friendly when it comes to formatting. It truncates text here there and everywhere when it wants to and without notice. Text overflows into oblivion - without warning.

What if you want to display the full text of a truncated cell?

Well, you could resize the cell - but that would ruin all your formatting, and it only works for one cell.

Or you could expand the formula bar like this:

But the formula bar only displays formulas, it doesn't display the text produced by the formulas:

Really what it should do is give you an automatically resized tool tip showing you the full text of a cell when you mouse-over.

Well now you can with the VBA macro below.

'

' This VBA macro automatically adds tool tips (aka Comments) to cells that have obscured text.

'

' Copy all the code below into ThisWorkbook module

' WARNING: the manually typed comments in the sheets

' of this workbook will be destroyed!

' Contains code from http://www.mrexcel.com/forum/excel-questions/520326-display-cell-contents-via-tooltip-2.html

' and http://www.contextures.com/xlcomments03.html#Resize (deprecated)

'

' Uses a Text Box to determine whether the text is obscured, and the required size of the text.

'

' Written by Edward Chan 2013-11-14

Private Sub Workbook_SheetActivate(ByVal Sh As Object)

addComments Sh.UsedRange

End Sub

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)

' addComments Sh.UsedRange

End Sub

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)

On Error Resume Next

Sh.UsedRange.SpecialCells(xlCellTypeComments).ClearComments

End Sub

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

addComments Target

End Sub

Private Sub addComments(Optional Rng As Range)

Dim x As Range

If Rng Is Nothing Then Set Rng = ActiveSheet.UsedRange

' If Rng.Count > 1000 Then Exit Sub

With Application

.ScreenUpdating = False

.DisplayCommentIndicator = xlCommentIndicatorOnly

End With

For Each x In Rng.Cells

With x

If Len(.Text) > 30 And .WrapText = True Then

.ClearComments

' Recreate a Text Box the same size and properties as the cell

Dim qShape As Shape

Set qShape = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 100, 100, x.Width, x.Height + 5)

qShape.TextFrame.Characters.Text = x.Text

qShape.TextFrame2.TextRange.Characters.ParagraphFormat.FirstLineIndent = 0

qShape.TextFrame2.TextRange.Characters.ParagraphFormat.SpaceWithin = 1.1

qShape.TextFrame2.TextRange.Characters.Font.Name = x.Font.Name

qShape.TextFrame2.TextRange.Characters.Font.Size = x.Font.Size

qShape.TextFrame2.MarginLeft = 2.8

qShape.TextFrame2.MarginRight = 2.8

qShape.TextFrame2.MarginTop = 0

qShape.TextFrame2.MarginBottom = 0

' Fit to shape and see if it has the same height.

qShape.TextFrame2.AutoSize = msoAutoSizeShapeToFitText

' If a larger height, add a comment/tooltip

If qShape.Height > x.Height + 5 Then

' Figure out size of shape

qShape.Width = 400

qShape.TextFrame2.TextRange.Characters.Font.Size = 11

qShape.TextFrame2.AutoSize = msoAutoSizeShapeToFitText

With .AddComment(.Text).Shape

.TextFrame.Characters.Font.Size = 11

.Width = qShape.Width

.Height = qShape.Height + 10

' .TextFrame.AutoSize = True

' If .Width > 400 Then

' lArea = .Width * .Height

' .Width = 400

' ' An adjustment factor of 1.1 seems to work ok.

' .Height = (lArea / 400) * 1.1

' End If

End With

qShape.Delete

Else

qShape.Delete

End If

End If

End With

Next

Application.ScreenUpdating = True

End Sub

To get the tool tip centred on the screen, you need to add the following macro to each worksheet:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'www.contextures.com/xlcomments03.html

Dim rng As Range

Dim cTop As Long

Dim cWidth As Long

Dim cmt As Comment

Dim sh As Shape

Application.DisplayCommentIndicator _

= xlCommentIndicatorOnly

Set rng = ActiveWindow.VisibleRange

cTop = rng.Top + rng.Height / 2

cWidth = rng.Left + rng.Width / 2

If ActiveCell.Comment Is Nothing Then

'do nothing

Else

Set cmt = ActiveCell.Comment

Set sh = cmt.Shape

sh.Top = cTop - sh.Height / 2

sh.Left = cWidth - sh.Width / 2

cmt.Visible = True

End If

End Sub