Excel/Bubble Chart

Advertisement


Question
Sheet2
Sheet2  
Sheet1
Sheet1  
QUESTION: Hi Jerry,

I have been trying to write a macro to create a a Bubble Chart I have succeeded in creating it, but I have to copy the info from Sheet1 to Sheet2. Also, I am planning in the future to add more columns of data, so I need the range to be dynamic. Furthermore, I don't want to have to manually select the data like I currently have it before being able to run the macro.

So, I was wondering if you can please offer some guidance in creating a macro that does what mine already does, but

1. Is able to get the data from Sheet1 when I click the button in Sheet2.
2. The number of columns in the data changes according to how many columns have info in them.
3. I currently have a horizontal and a vertical lines on the plot, but they are just drawings. I want to be able to actually plot a vertical line at 4.5 and a horizontal line at 5.5. Is this possible?

Note the not all rows in Sheet1 are used! Please see the macro below, and the pictures, to make better sense of it.


Public Sub BubbleChart()
   If (Selection.Rows.Count <> 4 Or Selection.Columns.Count < 3) Then
       MsgBox "Please select your data. Selection must have 4 rows and at least 2 coloumns!"
       Exit Sub
   End If
   
   Dim BubbleChart As ChartObject
   Set BubbleChart = ActiveSheet.ChartObjects.Add(Left:=50, Width:=1200, Top:=150, Height:=800)
   BubbleChart.Chart.ChartType = xlBubble
   d = Selection.Columns.Count
   Dim c As Integer
   For c = 2 To Selection.Columns.Count
       With BubbleChart.Chart.SeriesCollection.NewSeries
         .Name = "=" & Selection.Cells(1, c).Address(External:=True)
         .XValues = Selection.Cells(2, c).Address(External:=True)
         .Values = Selection.Cells(3, c).Address(External:=True)
         .BubbleSizes = Selection.Cells(4, c).Address(External:=True)


       End With
       
   Next

   BubbleChart.Chart.SetElement (msoElementPrimaryCategoryAxisTitleAdjacentToAxis)
   BubbleChart.Chart.Axes(xlCategory, xlPrimary).AxisTitle.Text = "=" & Selection.Cells(2, 1).Address(External:=True)
   
   BubbleChart.Chart.SetElement (msoElementPrimaryValueAxisTitleRotated)
   BubbleChart.Chart.Axes(xlValue, xlPrimary).AxisTitle.Text = "=" & Selection.Cells(3, 1).Address(External:=True)
   
   BubbleChart.Chart.SetElement (msoElementPrimaryCategoryGridLinesMajor)
   BubbleChart.Chart.Axes(xlCategory).MinimumScale = 2
   
   BubbleChart.Chart.Axes(xlCategory).Select
   BubbleChart.Chart.Axes(xlCategory).MinimumScale = 2.5
   BubbleChart.Chart.Axes(xlCategory).MaximumScale = 9
   BubbleChart.Chart.Axes(xlValue).Select
   BubbleChart.Chart.Axes(xlValue).MinimumScale = 3
   BubbleChart.Chart.SeriesCollection(4).Select
   BubbleChart.Chart.ChartGroups(1).BubbleScale = 40
   BubbleChart.Chart.SetElement (msoElementChartTitleAboveChart)
   BubbleChart.Chart.ChartTitle.Text = "Projects"
       Selection.Format.TextFrame2.TextRange.Characters.Text = "Projects"
   With Selection.Format.TextFrame2.TextRange.Characters(1, 8).ParagraphFormat
       .TextDirection = msoTextDirectionLeftToRight
       .Alignment = msoAlignCenter
   End With
   With Selection.Format.TextFrame2.TextRange.Characters(1, 8).Font
       .BaselineOffset = 0
       .Bold = msoTrue
       .NameComplexScript = "+mn-cs"
       .NameFarEast = "+mn-ea"
       .Fill.Visible = msoTrue
       .Fill.ForeColor.RGB = RGB(0, 0, 0)
       .Fill.Transparency = 0
       .Fill.Solid
       .Size = 35
       .Italic = msoFalse
       .Kerning = 12
       .Name = "+mn-lt"
       .UnderlineStyle = msoNoUnderline
       .Strike = msoNoStrike
   End With
   


For Counter = 1 To (d - 1)
   ActiveChart.SeriesCollection(Counter).Points(1).Select
   ActiveChart.SeriesCollection(Counter).Points(1).ApplyDataLabels
   ActiveChart.SeriesCollection(Counter).DataLabels.Select
   Selection.ShowSeriesName = True
   Selection.ShowValue = False
   Selection.Format.TextFrame2.TextRange.Font.Size = 15
   Selection.Format.TextFrame2.TextRange.Font.Bold = msoTrue

   
Next Counter
   
For e = 1 To (d - 1)
   ActiveChart.SeriesCollection(e).Points(1).Select
   With Selection.Format.Fill
       .Visible = msoTrue
       .ForeColor.RGB = RGB(153, 204, 0)
       .Transparency = 0
       .Solid
   End With
Next e

   
   BubbleChart.Chart.Shapes.AddTextbox(msoTextOrientationHorizontal, 63, 77, 138, 60). _
       Select
   Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = _
       "One"
   Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 3).ParagraphFormat. _
       FirstLineIndent = 0
   Selection.ShapeRange.TextFrame2.TextRange.Font.Bold = msoTrue
   Selection.ShapeRange.TextFrame2.TextRange.Font.Size = 20
   Selection.ShapeRange.TextFrame2.TextRange.Font.Italic = msoTrue

   
   BubbleChart.Chart.Shapes.AddTextbox(msoTextOrientationHorizontal, 1100, 77, 80, 30). _
       Select
   Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = _
       "Two"
   Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 3).ParagraphFormat. _
       FirstLineIndent = 0
   Selection.ShapeRange.TextFrame2.TextRange.Font.Bold = msoTrue
   Selection.ShapeRange.TextFrame2.TextRange.Font.Size = 20
   Selection.ShapeRange.TextFrame2.TextRange.Font.Italic = msoTrue
   
   
   BubbleChart.Chart.Shapes.AddTextbox(msoTextOrientationHorizontal, 1100, 670, 80, 30). _
       Select
   Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = _
       "Three"
   Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 5).ParagraphFormat. _
       FirstLineIndent = 0
   Selection.ShapeRange.TextFrame2.TextRange.Font.Bold = msoTrue
   Selection.ShapeRange.TextFrame2.TextRange.Font.Size = 20
   Selection.ShapeRange.TextFrame2.TextRange.Font.Italic = msoTrue
   
   
   BubbleChart.Chart.Shapes.AddTextbox(msoTextOrientationHorizontal, 63, 660, 140, 60). _
       Select
   Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = _
       "Four"
   Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 4).ParagraphFormat. _
       FirstLineIndent = 0
   Selection.ShapeRange.TextFrame2.TextRange.Font.Bold = msoTrue
   Selection.ShapeRange.TextFrame2.TextRange.Font.Size = 20
   Selection.ShapeRange.TextFrame2.TextRange.Font.Italic = msoTrue
   
   
   ActiveChart.Legend.Select
   Selection.Delete
   ActiveChart.Axes(xlCategory).AxisTitle.Select
   Selection.Format.TextFrame2.TextRange.Font.Size = 18
   ActiveChart.Axes(xlValue).AxisTitle.Select
   Selection.Format.TextFrame2.TextRange.Font.Size = 18
   
   ActiveChart.Axes(xlCategory).Select
   With Selection.TickLabels.Font
       .Size = 13
      ' .Bold = True
   End With
   ActiveChart.Axes(xlValue).Select
   With Selection.TickLabels.Font
       .Size = 13
      ' .Bold = True
   End With
   
   
   
ActiveChart.Shapes.AddConnector(msoConnectorStraight, 395, 58, 395, 748).Select
   With Selection.ShapeRange.Line
       .Visible = msoTrue
       .DashStyle = msoLineDash
       .Weight = 2.75
       .ForeColor.RGB = RGB(7, 114, 255)
       .Transparency = 0
   End With

   ActiveChart.Shapes.AddConnector(msoConnectorStraight, 45, 400, 1175, 400).Select
   With Selection.ShapeRange.Line
       .Visible = msoTrue
       .DashStyle = msoLineDash
       .Weight = 2.75
       .ForeColor.RGB = RGB(7, 114, 255)
       .Transparency = 0
   End With
   


End Sub

ANSWER: Start your macro like this.... it will copy in the line from Sheet1, select them, then proceed with your macro as you've created it.

Public Sub BubbleChart()
Dim BubbleChart As ChartObject, c As Long

    For Each BubbleChart In ActiveSheet.ChartObjects
        BubbleChart.Delete
    Next BubbleChart
    
    Sheets("Sheet1").Range("1:2,5:5,9:9").Copy
    Range("A1").PasteSpecial xlPasteValues
    Range("A1").CurrentRegion.Select

    If (Selection.Rows.Count <> 4 Or Selection.Columns.Count < 3) Then
        MsgBox "Please select your data. Selection must have 4 rows and at least 2 coloumns!"
        Exit Sub
    End If



---------- FOLLOW-UP ----------

sheet1
sheet1  
QUESTION: Hi Jerry,

Thanks for getting back to me so quickly!

I copied the code you sent, but I am running into some trouble.

To make things easier I simplified "Sheet1". Please see the attached picture. The data I use actually does not start in Column A. It starts in column "E" and goes to an ever changing number of columns.

Also, I do not really need to copy the data into "Sheet2"; it can stay in "Sheet1". I just want to be able to use the data from there.

Additionally, I do not know if it was clear from the spreadsheet, but in case I caused some confusion, I want to clarify that

Name is the name of each series.
Pres is the x values
Score is the y values
Total is the size of the bubble.

Finally, I currently have a horizontal and a vertical lines on the plot, but they are just drawings. I want to be able to actually plot a vertical line at 4.5 and a horizontal line at 5.5. Is this possible?

Answer
The part I can help with is getting the data into position on Sheet2 so your existing macro will still work with your changing data.  This tweak will remove the unneeded 5 columns of data before running your bubblechart creation code.

Public Sub BubbleChart()
Dim BubbleChart As ChartObject, c As Long

    For Each BubbleChart In ActiveSheet.ChartObjects
        BubbleChart.Delete
    Next BubbleChart
    
    Sheets("Sheet1").Range("1:2,5:5,9:9").Copy
    Range("A1").PasteSpecial xlPasteValues
    Range("A:D").Delete
    Range("A1").CurrentRegion.Select

    If (Selection.Rows.Count <> 4 Or Selection.Columns.Count < 3) Then
        MsgBox "Please select your data. Selection must have 4 rows and at least 2 coloumns!"
        Exit Sub
    End If

About Excel
This topic answers questions related to Microsoft Excel spreadsheet (or workbook) stand-alone or Mircrosoft Office Excel including Excel 2003, Excel 2007, Office 2000, and Office XP. You can get Excel help on Excel formulas(or functions), Excell macros, charting in Excel, advanced features, and the general use of Excel. This does not provide a general Excel tutorial nor the basics of using a spreadsheet. It provides specific answers to using Microsoft Excel only. If you do not see your Excel question answered in this area then please ask an Excel question here

Excel

All Answers


Answers by Expert:


Ask Experts

Volunteer


Jerry Beaucaire

Expertise

Excel Formulas, macros, automation. Microsoft Excel MVP - 2010. Code site with free code snippets and techniques: http://sites.madrocketscientist.com/jerrybeaucaires-excelassistant/files

Experience

Microsoft Excel MVP - 2010. I have my own extensive Excel help/code site: http://sites.madrocketscientist.com/jerrybeaucaires-excelassistant/files ===================== I have been offering free assistance as an Excel aid on many web sites for many years: (http://www.excelforum.com - JBeaucaire) ======== (http://www.askmehelpdesk.com/spreadsheets - JBeaucaire) ======= (http://www.mrexcel.com/forum - jbeaucaire)

Education/Credentials
Bachelor's Degree from Azusa Pacific University in Mathematics and Music Composition

Awards and Honors
Microsoft Excel MVP 2010

©2016 About.com. All rights reserved.