Customize Hover on scatter plots

[kwadjo]

I have a scatter chart that has enough points that labelling is not an option. I'd like to customize the hover to display not only the x,y and series, but also another column of my data (project name). The data is organized like this (with some dummy data:

Project Name	Score	Department	Status	In Progress	Not Started
Create Dashboard	20​	1​	in progress	20	#N/A
Customize Hover	30​	2​	Not Started	#N/A	30

My scatter has the score on the y axis and department number on the x, with In Progress and Not started as the series. I'd like to be able to show the Project Name on the hover over. I found some code online using Chart Events but have been unable to get it to work properly. My chart is imbedded in a worksheet (it is not a chart sheet), which seems to add a lot of complexity. I would appreciate some help as I am very inexperienced with VBA.

Another acceptable option would be to output the x/y data to a few cells when a point is clicked on the chart, then I can write a formula to pull in the project name next to the chart.

 

[kwadjo]

Figured it out. Here is the code if anyone else is trying to do it. Create a class module that has the following code:

Option Explicit

' Declare object of type "Chart" with events
Public WithEvents EventChart As Chart



Private Sub EventChart_MouseUp(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)

Dim ElementID As Long, Arg1 As Long, Arg2 As Long
Dim myX As Variant, myY As Double

With ActiveChart
' Pass x & y, return ElementID and Args
.GetChartElement x, y, ElementID, Arg1, Arg2

' Did we click over a point or data label?
If ElementID = xlSeries Or ElementID = xlDataLabel Then
If Arg2 > 0 Then
' Extract x value from array of x values
myX = WorksheetFunction.Index _
(.SeriesCollection(Arg1).XValues, Arg2)
' Extract y value from array of y values
myY = WorksheetFunction.Index _
(.SeriesCollection(Arg1).Values, Arg2)

' Display message box with point information
MsgBox Worksheets("HFHI Projects List").Range("Project_desc").Cells(Arg2, 1).Value & vbCrLf _
& """" & .SeriesCollection(Arg1).Name & """" & vbCrLf _
& "Score = " & myY
End If
End If
End With
End Sub



Then create a module with:

Option Explicit

Dim clsAppEvent As New CAppEvent
Dim clsChartEvent As New CChartEvent
Dim clsChartEvents() As New CChartEvent

Sub InitializeAppEvents()
Set clsAppEvent.EventApp = Application
Set_All_Charts
End Sub

Sub TerminateAppEvents()
Set clsAppEvent.EventApp = Nothing
Reset_All_Charts
End Sub

Sub Set_All_Charts()
' Enable events for active sheet if sheet is a chart sheet
If TypeName(ActiveSheet) = "Chart" Then
Set clsChartEvent.EventChart = ActiveSheet
End If

' Enable events for all charts embedded on a sheet
' Works for embedded charts on a worksheet or chart sheet
If ActiveSheet.ChartObjects.Count > 0 Then
ReDim clsChartEvents(1 To ActiveSheet.ChartObjects.Count)
Dim chtObj As ChartObject
Dim chtnum As Integer

chtnum = 1
For Each chtObj In ActiveSheet.ChartObjects
' Debug.Print chtObj.Name, chtObj.Parent.Name
Set clsChartEvents(chtnum).EventChart = chtObj.Chart
chtnum = chtnum + 1
Next ' chtObj
End If
End Sub

Sub Reset_All_Charts()
' Disable events for all charts previously enabled together
Dim chtnum As Integer
On Error Resume Next
Set clsChartEvent.EventChart = Nothing
For chtnum = 1 To UBound(clsChartEvents)
Set clsChartEvents(chtnum).EventChart = Nothing
Next ' chtnum
End Sub


Hope this helps.