Bubble Chart Not Updating Based on Macro

[fergusga1815]

As per the attached workbook I have a bubble chart on sheet 'Prioritisation' which is taking its series data points from the sheet 'Master Copy'. I also have a macro which is designed to update the bubble colours based on the cell colour of column AJ on the 'Master Copy' worksheet.

The macro is:

Option Explicit
Sub ColorChartSeries()
Dim iRow As Long, iCol As Long
Dim theBubbles As Range
Dim theChart As Chart
Dim theSeries As Series
Dim thePoint As Point

Set theChart = ActiveChart

If (theChart.ChartType <> xlBubble And theChart.ChartType <> xlBubble3DEffect) Then
    MsgBox "This works only for bubble charts!"
    End
End If

For Each theSeries In theChart.SeriesCollection
    Set theBubbles = Range(theSeries.BubbleSizes)
    iRow = 1
    For Each thePoint In theSeries.Points
        thePoint.Format.Fill.ForeColor.RGB = Intersect(Worksheets("Master Copy").Range("AJ:AJ"), theBubbles.Rows(iRow).EntireRow).DisplayFormat.Interior.Color
        iRow = iRow + 1
    Next thePoint
Next theSeries

End Sub

As you will see the bubble colours do not reflect the cell and also do not update if I use the slicers associated to the 'Master Copy' worksheet

[Andy Pope]

Because the rows in the table, which are used in the chart, may not be contiguous when a filter is applied you need to use Areas/Cells to get the corresponding bubble cell from the range.

Sub ColorChartSeries()
Dim iRow As Long, iCol As Long
Dim theBubbles As Range
Dim theChart As Chart
Dim theSeries As Series
Dim thePoint As Point
Dim areaIndex As Long
Dim cellIndex As Long

Set theChart = ActiveChart

If (theChart.ChartType <> xlBubble And theChart.ChartType <> xlBubble3DEffect) Then
    MsgBox "This works only for bubble charts!"
    End
End If

For Each theSeries In theChart.SeriesCollection
    Set theBubbles = Range(theSeries.BubbleSizes).SpecialCells(xlCellTypeVisible)
    areaIndex = 1
    cellIndex = 1
    For Each thePoint In theSeries.Points
        If cellIndex > theBubbles.Areas(areaIndex).Cells.Count Then
            areaIndex = areaIndex + 1
            cellIndex = 1
        End If
        thePoint.Format.Fill.ForeColor.RGB = Intersect(Worksheets("Master Copy").Range("AJ:AJ"), theBubbles.Areas(areaIndex).Cells(cellIndex).EntireRow).DisplayFormat.Interior.Color
        cellIndex = cellIndex + 1
    Next thePoint
Next theSeries

End Sub

If the conditional formatting changes the colour to display when filtered then you will need to capture the calculate event of the table sheet in order to rerun the format macro.

[fergusga1815]

Thanks Andy. That works perfectly until I use the slicer and new data is loaded and then the bubble colours are wrong and I need to manually run the macro again for these to be corrected. Any thoughts on how this can be corrected so that the macro doesn't have to be manually run?

[fergusga1815]

Also I don't know if there is any way for the macro to run without having to phyically click on the chart itself first?

[Andy Pope]

As I mentioned, "capture the calculate event of the table sheet", in order to run the macro.

Replace Activechart with worksheets("Prioritisation").chartobjects(1).chart

[fergusga1815]

Thanks Andy, in reference to "capture the calculate event of the table sheet" I am actually not sure how to do this but based on your description I am not sure it is the issue. Using the slicers does not change the conditional cell colour of any cell, these are based on a formula from data points only not related to the chart/slicers.

The issue seems to be that if I use the slicer the bubble colours are incorrect until I re-run the macro and then they are corrected, I would just like them to be correct without having to re-run the macro manually.

[Andy Pope]

Right click Master Copy sheet and add the following event code

Private Sub Worksheet_Calculate()
ColorChartSeries

End Sub

[fergusga1815]

Thank you so much Andy, it works perfectly!!!!