none
Update Chart.SeriesCollection after using a slicer RRS feed

  • Question

  • Hi,

    How can I update a chart's SeriesCollection when selecting values in a slicer? I'm using VBA to get data labels in a scatter chart but I also need to use slicers to filter the data. However, the SeriesCollection doesn't update when using a slicer which in turn causes the labels to show incorrect values.

    Monday, November 30, 2015 8:51 AM

Answers

  • Hi David,

    Thanks, that's a start for going to the right direction. However, that one doesn't take into account the possibility that there could be the same number on column Val2 (or Val1) twice. I have basically the solution ready but some of VBA's quirks are still bothering me. With a small sample size everything works fine but with larger sample something breaks down. When the values have decimals, the Find method has some trouble, but seems to work somewhat ok, if I format the values.

    Edit: Got it working properly. I had to abandon the Find method that didn't just work with decimals. The sub still has some potential for improvement but at least now I have a working solution:

    Private Sub MyChartClass_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 s As Series
    Dim vals
    Dim vals2
    Dim rownum As Integer
    Dim xRange As Range
    Dim yRange As Range
    Dim ws As Worksheet
    Dim val1 As String, val2 As String
    
    
    MyChartClass.GetChartElement x, y, ElementID, Arg1, Arg2
    If ElementID = 3 Then
        Set s = MyChartClass.SeriesCollection(Arg1)
        vals = s.Values
        vals2 = s.XValues
        rownum = 0
        Set ws = Worksheets("Sheet1")
        Set yRange = ws.Columns(3)
        Set xRange = ws.Columns(4)
        val1 = Int(vals(Arg2))
        val2 = Int(vals2(Arg2)) For Each yc In yRange.Cells
            If yc.Row > WorksheetFunction.CountA(yRange) Then Exit For
            If CStr(yc.Cells(1).Value) Like val2 & "*" Then
                For Each xc In xRange.Cells
                    If xc.Row > WorksheetFunction.CountA(xRange) Then Exit For
                    If CStr(xc.Cells(1).Value) Like val1 & "*" Then
                        If yc.Row = xc.Row Then
                            rownum = yc.Row
                            Exit For
                        End If
                    End If
                Next
            End If
            If rownum <> 0 Then Exit For
        Next ActiveChart.SeriesCollection(Arg1).Points(Arg2).ApplyDataLabels ActiveChart.SeriesCollection(Arg1).Points(Arg2).DataLabel.Font.Size = 14 ActiveChart.SeriesCollection(Arg1).Points(Arg2).DataLabel.Position = xlLabelPositionTop ActiveChart.SeriesCollection(Arg1).Points(Arg2).DataLabel.Text = ws.Cells(rownum, 2) Else On Error Resume Next ActiveChart.SeriesCollection(Arg1).DataLabels.Delete On Error GoTo 0 End If End Sub


    • Edited by Roihut Tuesday, December 15, 2015 7:32 AM Working solution
    • Marked as answer by Roihut Tuesday, December 15, 2015 7:33 AM
    Monday, December 14, 2015 11:06 AM

All replies

  • >>>How can I update a chart's SeriesCollection when selecting values in a slicer? I'm using VBA to get data labels in a scatter chart but I also need to use slicers to filter the data. However, the SeriesCollection doesn't update when using a slicer which in turn causes the labels to show incorrect values.<<<

    According to your description, I have made a sample to try to reproduce this issue, unfortunately, I am not able to reproduce this issue.
    Firstly I created a scatter chart that use slicers to filter the data, you could refer to below:

    Secondly I created macro to get Text of DataLabel and X and Y values like below:

    Debug.Print ActiveChart.SeriesCollection(1).Points(1).DataLabel.Text
       
    Dim vX As Variant
    Dim vY As Variant
     
    vX = ActiveChart.SeriesCollection(1).XValues
    vY = ActiveChart.SeriesCollection(1).Values
     
    Debug.Print "X=" & vX(3) & ", Y=" & vY(3)

    Otherwise could you provide more information about your issue, for example worksheet,sample code and screen shot etc., that will help us reproduce and resolve your issues.

    Thanks for your understanding.

    Tuesday, December 1, 2015 6:17 AM
  • Hi David,

    Sorry for being too brief. I'll paste pictures of the problem and the code I'm using.

    Example data and chart:

    Oh well, can't post pictures because the forum won't let me.

    Here's the example data then:

    Year Label Val1 Val2
    2013 A 1 2
    2014 A 1,1 3
    2015 A 1,2 4
    2013 B 1 5
    2014 B 1,1 6
    2015 B 1,2 7
    2013 C 1 8
    2014 C 1,1 9
    2015 C 1,2 10

    The VBA-script:

    Public WithEvents MyChartClass As Chart
    
    Private Sub Worksheet_Activate()
        Set MyChartClass = ActiveSheet.ChartObjects(1).Chart
    End Sub
    
    Private Sub MyChartClass_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
    
    MyChartClass.GetChartElement x, y, ElementID, Arg1, Arg2
    If ElementID = 3 Then
        ActiveChart.SeriesCollection(Arg1).Points(Arg2).ApplyDataLabels
        ActiveChart.SeriesCollection(Arg1).Points(Arg2).DataLabel.Font.Size = 14
        ActiveChart.SeriesCollection(Arg1).Points(Arg2).DataLabel.Position = xlLabelPositionTop
        ActiveChart.SeriesCollection(Arg1).Points(Arg2).DataLabel.Text = Sheets("Sheet1").Cells(Arg2 + 1, 2)
    Else
        On Error Resume Next
        ActiveChart.SeriesCollection(1).DataLabels.Delete
        On Error GoTo 0
    End If
    End Sub
    
    And the problem that arises:

    No picture here...

    Use val1 for x and val2 for y.

    As you can see, the SeriesCollection doesn't update when the slicer is used, which causes the labels to show incorrect values.

    Thursday, December 3, 2015 6:56 AM
  • >>>As you can see, the SeriesCollection doesn't update when the slicer is used, which causes the labels to show incorrect values.

    According to your description, since you can't upload image, I just try to reproduce this issue with your sample data and code, then I am able to get this result like below:


    Do you want this result? if not, I suggest that you could upload your screen shot on OneDrive. It will help us reproduce and resolve your issue.

    For more information, click here to refer about Chart.GetChartElement Method (Excel)

    Friday, December 4, 2015 2:14 AM
  • Hi David,

    Let's see if it works now. Seems my account got finally verified and I can add pictures and links although the pictures don't show for some reason.

    Anyway link to first picture working as intended.
    Pic1

    Second picture using slicer showing incorrect label.

    Pic2



    • Edited by Roihut Friday, December 4, 2015 10:53 AM
    Friday, December 4, 2015 10:42 AM
  • Based on my testing, I find that this issue cause by this line code:

    ActiveChart.SeriesCollection(Arg1).Points(Arg2).DataLabel.Text = Sheets("Sheet1").Cells(Arg2 + 1, 2)


    So I suggest that you could modify your codes like below:

    Private Sub MyChartClass_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 s As Series
    Dim vals
    
    MyChartClass.GetChartElement x, y, ElementID, Arg1, Arg2
    If ElementID = 3 Then
    
        Set s = MyChartClass.SeriesCollection(1)
        vals = s.Values
        
        ActiveChart.SeriesCollection(Arg1).Points(Arg2).ApplyDataLabels
        ActiveChart.SeriesCollection(Arg1).Points(Arg2).DataLabel.Font.Size = 14
        ActiveChart.SeriesCollection(Arg1).Points(Arg2).DataLabel.Position = xlLabelPositionTop
        ActiveChart.SeriesCollection(Arg1).Points(Arg2).DataLabel.Text = Sheets("Sheet1").Cells(vals(Arg2), 2)
        Debug.Print "Arg1:" & Arg1
        Debug.Print "Arg2:" & Arg2
    
    Else
        On Error Resume Next
        ActiveChart.SeriesCollection(1).DataLabels.Delete
        On Error GoTo 0
    End If
    End Sub
    

    then you could get this result:


    • Edited by David_JunFeng Thursday, December 10, 2015 1:47 AM
    • Marked as answer by Roihut Thursday, December 10, 2015 9:38 AM
    • Unmarked as answer by Roihut Thursday, December 10, 2015 10:58 AM
    Wednesday, December 9, 2015 9:01 AM
  • Hi David,

    It works now for me too. Thanks a lot.

    Edit:

    Wait, scratch that. It doesn't work after all. Or it works, but only with those particular values. If you change them to 1000-1008 and 2000-2008 it no longer works since vals contains the values from column Val2.

    • Edited by Roihut Thursday, December 10, 2015 11:00 AM Doesn't work
    Thursday, December 10, 2015 9:38 AM
  • >>>If you change them to 1000-1008 and 2000-2008 it no longer works since vals contains the values from column Val2.

    According to your description, I have reproduced this issue, so I suggest that you could get row number by column Val2, you could modify like below cold:

    Dim rownum
    
    rownum = Cells.Find(vals(Arg2), LookIn:=xlValues, lookat:=xlWhole).Row
    ActiveChart.SeriesCollection(Arg1).Points(Arg2).DataLabel.Text = Sheets("Sheet1").Cells(rownum, 2)
    

    Friday, December 11, 2015 9:50 AM
  • Hi David,

    Thanks, that's a start for going to the right direction. However, that one doesn't take into account the possibility that there could be the same number on column Val2 (or Val1) twice. I have basically the solution ready but some of VBA's quirks are still bothering me. With a small sample size everything works fine but with larger sample something breaks down. When the values have decimals, the Find method has some trouble, but seems to work somewhat ok, if I format the values.

    Edit: Got it working properly. I had to abandon the Find method that didn't just work with decimals. The sub still has some potential for improvement but at least now I have a working solution:

    Private Sub MyChartClass_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 s As Series
    Dim vals
    Dim vals2
    Dim rownum As Integer
    Dim xRange As Range
    Dim yRange As Range
    Dim ws As Worksheet
    Dim val1 As String, val2 As String
    
    
    MyChartClass.GetChartElement x, y, ElementID, Arg1, Arg2
    If ElementID = 3 Then
        Set s = MyChartClass.SeriesCollection(Arg1)
        vals = s.Values
        vals2 = s.XValues
        rownum = 0
        Set ws = Worksheets("Sheet1")
        Set yRange = ws.Columns(3)
        Set xRange = ws.Columns(4)
        val1 = Int(vals(Arg2))
        val2 = Int(vals2(Arg2)) For Each yc In yRange.Cells
            If yc.Row > WorksheetFunction.CountA(yRange) Then Exit For
            If CStr(yc.Cells(1).Value) Like val2 & "*" Then
                For Each xc In xRange.Cells
                    If xc.Row > WorksheetFunction.CountA(xRange) Then Exit For
                    If CStr(xc.Cells(1).Value) Like val1 & "*" Then
                        If yc.Row = xc.Row Then
                            rownum = yc.Row
                            Exit For
                        End If
                    End If
                Next
            End If
            If rownum <> 0 Then Exit For
        Next ActiveChart.SeriesCollection(Arg1).Points(Arg2).ApplyDataLabels ActiveChart.SeriesCollection(Arg1).Points(Arg2).DataLabel.Font.Size = 14 ActiveChart.SeriesCollection(Arg1).Points(Arg2).DataLabel.Position = xlLabelPositionTop ActiveChart.SeriesCollection(Arg1).Points(Arg2).DataLabel.Text = ws.Cells(rownum, 2) Else On Error Resume Next ActiveChart.SeriesCollection(Arg1).DataLabels.Delete On Error GoTo 0 End If End Sub


    • Edited by Roihut Tuesday, December 15, 2015 7:32 AM Working solution
    • Marked as answer by Roihut Tuesday, December 15, 2015 7:33 AM
    Monday, December 14, 2015 11:06 AM