tooltip macro

[stratgery]

I am trying to write a macro that reads the first row of cell texts and returns an explanation based on what is in the cell. My report has 2 digit shorthand and I need a tooltip (or comment) to explain what it is. I pull the report often and I need the macro to make everyone's life easier. The codes are not always in the same column #, hence the need for the macro to read the individual cells and return the correct explanation.

Here is what I have so far:


‘Select the range of headers, either automatically or manually before triggering the macro headerRange=Range([first cell],[last cell)
‘or
headerRange=Selection
‘iterate through each cell of the range
For Each headerCell in headerRange
‘read the value
headerValue=headerCell.Value
‘choose the tooltip
Select Case headerValue
Case “AA”
Tooltip=”Tooltip for AA”
Case “AB”
Tooltip=”tooltip for AB”
‘…more cases
Case Else ‘default
Tooltip=””
End Select
‘write the tooltip
With headerCell.Validation
.Delete
.Add Type:=xlValidateCustom
.InputMessage=tooltip
End With

Next headerCell

[SamT]

Is there any reason other than seeing the tooltip for a user to select any header cells?
If not I would use a message box to show explanations for each header that is individually selected.

Worksheet code

Const msgFirstName = "These are the First Names of all Employees"
Const msgBirthday = "These are birthdays," & vbCrLf & "they are in standard Excel Date format" & vbCrLf _
"How many characters/ lines you want in your msgbox."
'Repeat as needed

Sub Worksheet_SelectionChange(ByVal Target as Range)
If Target.Count > 1 Then Exit Sub 'No multi selections
If Target.Row > 1 Then Exit Sub 'Only Headers
ShowMsg Target
End Sub

Sub ShowMsg(ByVal Target As Range)
Select Case Target.Value
Case is = "First Name"
MsgBox msgFirstName
Case is= "BirthDay"
MsgBox msgBirthday
BlahBlah
End Sub
you can even place all the message Constants in standard Module and keep the worksheet CodePage clean and brief.

[stratgery]

Not sure how to run this code, I wasn't able to have it work.

For ease of use of the report I need, it is better to not have a msgBox that you have to click out of. It would be great to just hover over the cell and have the explanation revealed.




Is there any reason other than seeing the tooltip for a user to select any header cells?
If not I would use a message box to show explanations for each header that is individually selected.

Worksheet code

Const msgFirstName = "These are the First Names of all Employees"
Const msgBirthday = "These are birthdays," & vbCrLf & "they are in standard Excel Date format" & vbCrLf _
"How many characters/ lines you want in your msgbox."
'Repeat as needed

Sub Worksheet_SelectionChange(ByVal Target as Range)
If Target.Count > 1 Then Exit Sub 'No multi selections
If Target.Row > 1 Then Exit Sub 'Only Headers
ShowMsg Target
End Sub

Sub ShowMsg(ByVal Target As Range)
Select Case Target.Value
Case is = "First Name"
MsgBox msgFirstName
Case is= "BirthDay"
MsgBox msgBirthday
BlahBlah
End Sub
you can even place all the message Constants in standard Module and keep the worksheet CodePage clean and brief.

[Paul_Hossler]

I think just using the built in Comment capability work be easiest

This just adds a 'tooltip' when you hover over the appropriate row 1 cell

If you're looking for something like Data Validation's messages that's something else



29429



Option Explicit


Sub AddTooltip()
Dim ws As Worksheet
Dim r As Range
Dim sHeader As String, sComment As String
Dim i As Long, n As Long


'setup
Set ws = Worksheets("Sheet1")

'header to get tooltip
sHeader = "StillMore"

'tooltip
sComment = "A = Ant" & Chr(10) & _
"B = Bird" & Chr(10) & _
"C = Cat" & Chr(10) & _
"D = Dog" & Chr(10) & _
"E = Elephant" & Chr(10) & _
"F = Fox" & Chr(10) & _
"G = Giraffe"

Set r = ws.Cells(1, 1).CurrentRegion

r.Rows(1).ClearComments

'find sHeader in Row 1
i = -1
On Error Resume Next
i = Application.WorksheetFunction.Match(sHeader, r.Rows(1), 0)
On Error GoTo 0

If i = -1 Then Exit Sub

'add the comment
r.Cells(1, i).AddComment (sComment)

'see how many new lines (not very exact)
For i = 1 To Len(sComment)
If Mid(sComment, i, 1) = vbLf Then n = n + 1
Next i
n = n + 1

'format
With ws.Comments(ws.Comments.Count).Shape
.AutoShapeType = msoShapeRoundedRectangle
.TextFrame.Characters.Font.Name = "Tahoma"
.TextFrame.Characters.Font.Size = 12
.TextFrame.Characters.Font.ColorIndex = 2
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = RGB(58, 82, 184)
.Fill.BackColor.RGB = 15652797
.Height = n * 1.5 * .TextFrame.Characters.Font.Size ' sort of a guess
.Width = 1.5 * .Width
End With
End Sub

[stratgery]

I really like the hoverable comment. I tried running it on another sheet and it did not work. How do you write the code so that it finds several header names? Your example provides a nice string of text for one specific header, but I won't need anything with that much detail. More like: AA=Monday, BB=Tuesday, etc. I have about 75 of these codes to provide hoverable comments, so it is worth my time to write it out in a code.

[Paul_Hossler]

Still not following the AA = Monday, etc.,

Col AA tooltip = "Monday"
Col BB tooltip = "Tuesday"

or something else???


but try this

29434





Option Explicit


Sub Tooltips()
Dim ws As Worksheet
Dim c As Comment

Set ws = Worksheets("Sheet1")

For Each c In ws.Comments
c.Delete
Next


Call AddTooltip(ws, "Data", "AA = Monday")
Call AddTooltip(ws, "MoreData", "BB = Tuesday")
Call AddTooltip(ws, "AllData", "CC = Wednesday")
End Sub






Private Sub AddTooltip(ws As Worksheet, HD As String, CM As String)
Dim i As Long

'find sHeader in Row 1 of WS
i = -1
On Error Resume Next
i = Application.WorksheetFunction.Match(HD, ws.Rows(1), 0)
On Error GoTo 0

If i = -1 Then Exit Sub

With ws.Cells(1, i)

.ClearComments
.AddComment CM

'format
With .Comment.Shape
.AutoShapeType = msoShapeRoundedRectangle
.TextFrame.Characters.Font.Name = "Tahoma"
.TextFrame.Characters.Font.Size = 12
End With
End With

End Sub



The one thing to be aware of is how the display height of a comment gets messed up when rows are frozen and you scroll down

You can adjust the height of row 1 or the height of the comment to have it completely display

2943629437


With .Comment.Shape
.AutoShapeType = msoShapeRoundedRectangle
.TextFrame.Characters.Font.Name = "Tahoma"
.TextFrame.Characters.Font.Size = 12
.Height = .Parent.Parent.RowHeight
End With

[stratgery]

This works well, thank you! Now to mark as solved ...