4

Objective: I'm looking to find the reference row number of data points from filtered series that have been scatter plotted from two separate sheets.

I'm following these guides, with little success:

  1. Excel VBA loop through visible filtered rows
  2. Excel vba - find row number where colum data (multiple clauses)

Scenario: I have two Sheets containing data in identical tabulated format:

+-----+-------------+---------+---------+-------+
| Row | Description | X-value | Y-value | Score |
+-----+-------------+---------+---------+-------+
|   1 | "Something" |     3.4 |     4.5 |   7.0 |
|   2 | "Something" |     2.3 |     2.4 |   5.6 |
| ... | ...         |     ... |     ... |   ... |
| 100 | "Something" |     6.5 |     4.2 |   8.0 |
+-----+-------------+---------+---------+-------+

x-val and y-val from each sheet has been scatter plotted as separate series on the same chart.

I have a VBA script that on mouse hover on the chart returns the series index, x, and y coordinates of the specific data point (Arg1, ser.Values, ser.XValues):

Private Sub Chart_MouseMove(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)
Dim ElementID As Long
Dim Arg1 As Long
Dim Arg2 As Long
Dim chart_data As Variant
Dim chart_label As Variant
Dim last_point As Long
Dim chrt As Chart
Dim ser As Series
Dim score As Double
Dim desc As String

On Error Resume Next    

Me.GetChartElement x, y, ElementID, Arg1, Arg2

Application.ScreenUpdating = False
Set chrt = ActiveChart
Set ser = ActiveChart.SeriesCollection(Arg1)
'x and y values
chart_data = ser.Values
chart_label = ser.XValues

If the list is unfiltered it seems the series' point index matches the row number so I can get a reference to the row and extract info quite easily:

If Arg1 = 1 Then
score = Sheet1.Cells(Arg2 + 1, "E").Value
desc = Sheet1.Cells(Arg2 + 1, "B").Value
End If

If Arg1 = 2 Then
score = Sheet2.Cells(Arg2 + 1, "E").Value
desc = Sheet2.Cells(Arg2 + 1, "B").Value
End If

Complexity: Each sheet filters on score and dynamically update the chart, so the resulting row numbers in each sheet may not contiguous. Some rows are hidden.

The above indices no longer match the correct row, so my code returns the wrong information.

Eg. Scores > 6

+-----+-------------+---------+---------+-------+
| Row | Description | X-value | Y-value | Score |
+-----+-------------+---------+---------+-------+
|   1 | "Something" |     3.4 |     4.5 |   7.0 |
| 100 | "Something" |     6.5 |     4.2 |   8.0 |
+-----+-------------+---------+---------+-------+

Outcome: I would like to use the x, y values to search the visible list on each sheet and retrieve the row number. So that I can then retrieve the description and score to pipe into my mouse-over pop-up message.

I'm a novice in VBA and guidance is appreciated.


Update 1: Showing code to do mouse-hover and adopting DisplayName's answer. It does not work for all data points, and displays a blank box. Currently trying to debug. When comparing to my original code with no filtering on rows.

Clarification: X values (and Y) could be the same. Where there are duplicate X and Y returning the first match would be ok.

Set txtbox = ActiveSheet.Shapes("hover")

If ElementID = xlSeries And Arg1 <= 2 Then
' Original code that only works on un-filtered rows in Sheet 1 & 2
'    If Arg1 = 1 Then
'        score = Sheet1.Cells(Arg2 + 1, "E").Value
'        desc = Sheet1.Cells(Arg2 + 1, "B").Value
'    ElseIf Arg1 = 2 Then
'        score = Sheet2.Cells(Arg2 + 1, "E").Value
'        desc = Sheet2.Cells(Arg2 + 1, "B").Value
'    End If

' Code from DisplayName
    With Worksheets(Choose(Arg1, Sheet1.Name, Sheet2.Name)) ' reference Sheet1 if Arg1=1 and Sheet2 if Arg1=2
        With .Range("C2", .Cells(.Rows.Count, "C").End(xlUp)).Find(what:=chart_label(Arg2), LookIn:=xlValues, lookat:=xlWhole) ' search reference referenced sheet x-values range for current x-value
            If .Offset(, 1).Value = chart_data(Arg2) Then 'check y-value
                score = .Offset(, 2).Value     ' assign 'score' the value of found cell offset two columns to the right
                desc = .Offset(, -1).Value ' assign 'desc' the value of found cell offset one column to the left
            End If
        End With
    End With

    If Err.Number Then
        Set txtbox = ActiveSheet.Shapes.AddTextbox _
                                        (msoTextOrientationHorizontal, x - 150, y - 150, 300, 50)
        txtbox.Name = "hover"
        txtbox.Fill.Solid
        txtbox.Fill.ForeColor.SchemeColor = 9
        txtbox.Line.DashStyle = msoLineSolid
        chrt.Shapes("hover").TextFrame.Characters.Text = "Y: " & Application.WorksheetFunction.Text(chart_data(Arg2), "?.?") & _
                                                                                        ", X: " & Application.WorksheetFunction.Text(chart_label(Arg2), "?.?") & _
                                                                                        ", Score: " & Application.WorksheetFunction.Text(score, "?.?") & ", " & desc
        With chrt.Shapes("hover").TextFrame.Characters.Font
            .Name = "Arial"
            .Size = 12
            .ColorIndex = 16
        End With
        last_point = Arg2
    End If
    txtbox.Left = x - 150
    txtbox.Top = y - 150

Else
    txtbox.Delete
End If
Application.ScreenUpdating = True
End Sub

Update 2: As Tim Williams noted there is no way to get around this without looping through the range. I combined his pseudocode with DisplayName's example to get the desired behavior where x, y is compared to get the score and description. Here is the code that worked:

   With Worksheets(Choose(Arg1, Sheet1.Name, Sheet2.Name))
            For Each row In .Range("C2", .Cells(.Rows.Count, "C").End(xlUp)).SpecialCells(xlCellTypeVisible)
                If row.Value = chart_label(Arg2) And row.Offset(, 1).Value = chart_data(Arg2) Then
                    score = row.Offset(, 2).Value
                    desc = row.Offset(, -1).Value
                    Exit For
                End If
            Next row
    End With

I wish I could split the bounty between Tim Williams and Display Name. As I can only choose one the award goes to Tim.

0m3r
  • 12,286
  • 15
  • 35
  • 71
tekiwibird
  • 103
  • 10

3 Answers3

3

You can do something like this:

'called from your event class using Arg1 and Arg2
Sub HandlePointClicked(seriesNum As Long, pointNum As Long)

    Dim vis As Range, c As Range, i As Long, rowNum As Long
    Dim sht As Worksheet

    ' which sheet has the source data?
    Set sht = GetSheetFromSeriesNumber(seriesMum) 

    'Get only the visible rows on the source data sheet
    '   (adjust to suit your specific case...)
    Set vis = sht.Range("A2:A100").SpecialCells(xlCellTypeVisible)

    'You can't index directly into vis 
    '  eg. vis.Cells(pointNum) may not work as you might expect
    '  so you have (?) to do something like this loop
    For Each c In vis.Cells
        i = i + 1
        If i = pointNum Then rowNum = c.Row
    Next c

    Debug.Print rowNum '<< row number for the activated point

End Sub
Tim Williams
  • 154,628
  • 8
  • 97
  • 125
1

As reparation of my earlier attempt to answer without going into details of your question and to prevent my deleted answer to be viewed by experts, I am offering another solution. But before going into codes and all, I must acknowledge that the best solution is already provided by @Tim Williams and think only his answer is worthy to be accepted (till date). I found no other option to get row numbers without looping.

I only attempting to put the pieces together and integrating with your code. I have taken following liberties

  1. Used class module as directly coding Chart_MouseMove may become troublesome while modifying/working with chart.

  2. Chart is placed on the worksheet only

  3. Used a stationary Textbox already placed on the chart to avoid deleting & recreating the same. It may cause problem in run time error

  4. Avoided disabling Screen update and Error bypass. You may please modify the code according to your requirement.

Now first insert a class module named CEvent. In the class module add

Public WithEvents Scatter As Chart
Private Sub Scatter_MouseMove(ByVal Button As Long, ByVal Shift As Long, ByVal X As Long, ByVal Y As Long)
Dim ElementID As Long
Dim Arg1 As Long
Dim Arg2 As Long
Dim chart_data As Variant
Dim chart_label As Variant
Dim last_point As Long
Dim chrt As Chart
Dim Ser As Series
Dim score As Double
Dim desc As String
Dim VRng, Cl As Range, SerStr As String, part As Variant, Txt As Shape
'On Error Resume Next
Set chrt = ActiveChart
chrt.GetChartElement X, Y, ElementID, Arg1, Arg2

'Application.ScreenUpdating = False

'x and y values

If ElementID = xlSeries And Arg1 <= 2 Then
Set Ser = ActiveChart.SeriesCollection(Arg1)
SerStr = Ser.Formula
part = Split(SerStr, ",")
Set VRng = Range(part(1)).SpecialCells(xlCellTypeVisible)
Vrw = 0
    For Each Cl In VRng.Cells
    Vrw = Vrw + 1
        If Vrw = Arg2 Then
        Exit For
        End If
    Next
score = Cl.Offset(, 2).Value
desc = Cl.Offset(, -1).Value
chart_data = Cl.Value
chart_label = Cl.Offset(, 1).Value

     Set Txt = ActiveSheet.Shapes("TextBox 2")

     'Txt.Name = "hover"
     Txt.Fill.Solid
     Txt.Fill.ForeColor.SchemeColor = 9
     Txt.Line.DashStyle = msoLineSolid
     Txt.TextFrame.Characters.Text = "Y: " & chart_label & ", X: " & chart_data & ", Score: " & score & ", " & vbCrLf & desc
        With Txt.TextFrame.Characters.Font
            .Name = "Arial"
            .Size = 12
            .ColorIndex = 16
        End With
      last_point = Arg2
      'Txtbox.Left = X - 150
      'Txtbox.Top = Y - 150
Else
'Txt.Visible = msoFalse
End If
'Application.ScreenUpdating = True
End Sub

Then in a standard module

Dim XCEvent As New CEvent
Sub InitializeChart()
Set XCEvent.Scatter = Worksheets(1).ChartObjects(1).Chart
Worksheets(1).Range("I25").Value = "Scatter Scan Mode On"
Worksheets(1).ChartObjects("Chart 1").Activate
End Sub
Sub ReleaseChart()
Set XCEvent.Scatter = Nothing
Worksheets(1).Range("I25").Value = "Scatter Scan Mode Off"
End Sub

The sub InitializeChart() & ReleaseChart() may be assigned to buttons placed on the worksheet near the chart. May please modify Sheet names, addresses, Chart name, Textbox names etc suitably. It is working with make shift filtered data

Screen Shots

Hope It will be useful

Ahmed AU
  • 2,757
  • 2
  • 6
  • 15
0

you have to find the cell with the current x-value and then offset from it

so substitute:

If Arg1 = 1 Then
score = Sheet1.Cells(Arg2 + 1, "E").Value
desc = Sheet1.Cells(Arg2 + 1, "B").Value
End If

If Arg1 = 2 Then
score = Sheet2.Cells(Arg2 + 1, "E").Value
desc = Sheet2.Cells(Arg2 + 1, "B").Value
End If

with:

With Worksheets(Choose(Arg1, Sheet1.Name, Sheet2.Name)) ' reference Sheet1 if Arg1=1 and Sheet2 if Arg1=2 
    With .Range("C2", .Cells(.Rows.Count, "C").End(xlUp)).Find(what:=chart_label(Arg2), LookIn:=xlValues, lookat:=xlWhole) ' search reference referenced sheet x-values range for current x-value
        score = .Offset(, 2).Value ' assign 'score' the value of found cell offset two columns to the right
        desc = .Offset(, -1).Value ' assign 'desc' the value of found cell offset one column to the left
    End With
End With
DisplayName
  • 13,283
  • 2
  • 11
  • 19
  • Does your answer also work when rows are non-contiguous from filtering? This works only to match the x-value and doesn't do well when rows are hidden. I had to include **.SpecialCells(xlCellTypeVisible)** after **.End(xlUp))** for hidden rows and an **If .Offset(, 1).Value = chart_data(Arg2) Then** statement before assigning score and desc to check for y-values. In some mouse-hover events the score and desc were not being found - possibly due to making the the chosen Sheet1.Name or Sheet2.Name active? – tekiwibird Nov 04 '18 at 16:58
  • It works for non contiguous range, also. I assumed x-values are unique. No need for SpecialCells. My code doesn’t make any sheet active – DisplayName Nov 04 '18 at 17:12
  • You may aldo want to add some “If ElementID = xlSeries Then” check to do things only upon hovering a series – DisplayName Nov 04 '18 at 17:18
  • Yes, I'll update my question with the rest of my code. It seems there is complexity when matching x and y values that stops your solution from working. – tekiwibird Nov 04 '18 at 17:45
  • It seems your code has stopped working all together, do you have to instantiate anything in the sub to make the With statements work? It seems score and desc are now returning Empty and "". A bit lost as to why, all thats changed is opening the workbook in Windows vs osx. – tekiwibird Nov 04 '18 at 23:04
  • No need for _“If .Offset(, 1).Value = chart_data(Arg2) Then”_ you added – DisplayName Nov 05 '18 at 06:21
  • I've copied your code word for word and no luck, how do I evaluate the objectExpressions after the With statements to make sure they are working? – tekiwibird Nov 05 '18 at 18:41
  • When I use ? With Worksheets(Choose(Arg1, Sheet1.Name, Sheet2.Name)) in the immediate window after setting a breakpoint it gives me this error: Run-time error '438': Object doesn't support this property or method – tekiwibird Nov 05 '18 at 18:48