Article ID: 139662
Article Last Modified on 10/11/2006
Sub BubbleChart()
'define variables for workbook, chart, and chart series
MyBook = ActiveWorkbook.Name
MyChart = ActiveChart.Name
MySeries = ActiveChart.SeriesCollection(1).Formula
'define variables for worksheet and chart series reference
StartVal = InStr(InStr(1, MySeries, "(") + 1, MySeries, ",") + 1
EndSheetVal = InStr(StartVal, MySeries, "!")
mysheet = Mid(MySeries, StartVal, EndSheetVal - StartVal)
EndVal = InStr(StartVal, MySeries, ",")
mysource = Mid(MySeries, StartVal, EndVal - StartVal)
If InStr(mysheet,"'") Then 'strip out apostrophe
mysheet = Mid(mysheet, 2, Len(mysheet) - 2) 'if sheet name has a
End If 'space
'begin loop to add data labels to chart
Counter = 1
For Each xItem In Range(mysource)
xLabel = xItem.Offset(0, -1).Value
ActiveChart.SeriesCollection(1).Points(Counter).HasDataLabel _
=True
ActiveChart.SeriesCollection(1).Points(Counter).DataLabel.Text _
=xLabel
Counter = Counter + 1
Next xItem
'create oval on worksheet (used for chart bubbles)
Workbooks(MyBook).Sheets(mysheet).Activate
ActiveSheet.Ovals.Add(335.25, 12.75, 52.5, 52.5).Select
Application.ScreenUpdating = False
MyOval = ActiveSheet.DrawingObjects.Name
'get values from worksheet to compute bubble sizes
Set MyBubbleRange = Range(mysource).Offset(0, 3)
'begin loop to compute bubble size and add to chart data point
For Counter = 1 To MyBubbleRange.Count
BubbleValue = MyBubbleRange(Counter) * 50
ActiveSheet.DrawingObjects(MyOval).Select
With Selection
.Width = BubbleValue
.Height = BubbleValue
End With
Selection.Copy
Workbooks(MyBook).Sheets(MyChart).Activate
ActiveChart.SeriesCollection(1).Points(Counter).Select
Selection.Paste
'select worksheet
MyBubbleRange.Parent.Activate
Next Counter
'activate chartsheet
ActiveWorkbook.Sheets(MyChart).Activate
'remove oval from worksheet
ActiveWorkbook.Sheets(mysheet).DrawingObjects(MyOval).Delete
End Sub
A1: B1: Gross Revenues C1: Net Income D1: # of Plants
A2: East B2: 831191 C2: 35427 D2: 26
A3: West B3: 622199 C3: 54263 D3: 13
A4: North B4: 153794 C4: 80881 D4: 40
A5: South B5: 711327 C5: 33872 D5: 35
=D2/MAX($D$2:$D$5)
107729 Excel: Macro to Create Bubble Chart
Additional query words: bubbles circles XL
Keywords: kbhowto kbprogramming kbcode KB139662