bubble and pie chart in excel with vba code

[noob123]

<tbody>
[TD="class: votecell"][/TD]
[TD="class: postcell"] I wanted to use the following code to create a bubble pie chart in which the bubbles are pie charts.

Dim chtMarker As Chart
Dim chtMain As Chart
Dim intPoint As Integer
Dim rngRow As Range
Dim lngPointIndex As Long

Application.ScreenUpdating = False
Set chtMarker = ActiveSheet.ChartObjects("chtMarker").Chart
Set chtMain = ActiveSheet.ChartObjects("chtMain").Chart

Set chtMain = ActiveSheet.ChartObjects("chtMain").Chart
Set rngRow = Range(ThisWorkbook.Names("PieChartValues").RefersTo)

For Each rngRow In Range("PieChartValues").Rows
chtMarker.SeriesCollection(1).Values = rngRow
chtMarker.Parent.CopyPicture xlScreen, xlPicture
lngPointIndex = lngPointIndex + 1
chtMain.SeriesCollection(1).Points(lngPointIndex).Paste
Next

lngPointIndex = 0

Application.ScreenUpdating = True

End Sub

The code uses a single pie chart that is copied over and over again on the bubbles of the bubble chart.

How can I manage that not all pie charts in the bubble chart look alike? Since the code copies the pie as a filling into the bubble I wanted to know how whether there is an easy way to use a variable that dictates colour coding of every pie chart (in terms of RGB) or something ?
[/TD]

</tbody>

 

[Worf]

Hello and welcome to the Board

See if this is useful:

Sub Pies()


Dim chtMarker As Chart, chtMain As Chart, intPoint%, rngRow As Range, _
PointIndex&, i%, mk As Series, mn As Series


Randomize
'Application.ScreenUpdating = False


Set chtMarker = ActiveSheet.ChartObjects("chtMarker").Chart
Set chtMain = ActiveSheet.ChartObjects("chtMain").Chart
Set mk = chtMarker.SeriesCollection(1)
Set mn = chtMain.SeriesCollection(1)


PointIndex = 0
For Each rngRow In Range("PieChartValues").Rows
    mk.Values = rngRow
    For i = 1 To mk.Points.Count
        mk.Points(i).Format.Fill.ForeColor.RGB = _
        RGB(Int(250 * Rnd), Int(250 * Rnd), Int(250 * Rnd))
    Next
    chtMarker.Parent.CopyPicture xlScreen, xlPicture
    PointIndex = PointIndex + 1
    If PointIndex > mn.Points.Count Then
        Application.ScreenUpdating = True
        Exit Sub
    End If
    mn.Points(PointIndex).Paste
Next


Application.ScreenUpdating = True


End Sub