VBA to automatically add series to funnel plot

dmhanzo

New Member
Joined
Dec 28, 2014
Messages
1
Hello All,

I’m 100% naïve to VBA so please excuse me if I appear stupid with my questions.

I have a table where 1 part is used to draw control limits (upper and lower) as a funnel plot using scatter chart as a base graph.
The second part of the tables contains a set of certain values that should be placed against the controls on the chart. The set is dynamic and could be quite large that may return overwhelming results.

Columns I used for control limits are highlighted in red in the tracker. Columns I used for certain values markers are highlighted in blue in the tracker.

I used macro recorder to get VBA code drawing Control limits and it works fine. But I have problems with recording the second set of series. I can’t record them manually every time. So my questions are.

  1. What updates are necessary to the VBA code in order to automatically place all series that are currently in the tracker?
  2. Since it is likely to be very overwhelming, is it possible to somehow split number of series on the graph (e.g. create separate charts for every 30 records, but continue using the whole table for drawing Control limits)?
  3. Is it possible and how to color series markers on the chart based on additional attribute (City (orange highlighting) in my case)?

My code is:

Code:
Sub FunnelPlot()
'
' FunnelPlot Macro
'

'
' Drawing Control Limits

    Sheets("Sheet 1").Select
    Range("A2").Select
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.ChartType = xlXYScatter
    ActiveChart.SetSourceData Source:=Range("'Sheet 1'!$A$1:$O$502")
    Application.CutCopyMode = False
'' Deleting not used series that are placed automatically
    ActiveChart.SeriesCollection(1).Delete
    ActiveChart.SeriesCollection(1).Delete
    ActiveChart.SeriesCollection(1).Delete
    ActiveChart.SeriesCollection(11).Delete
    ActiveChart.SeriesCollection(10).Delete
    ActiveChart.SeriesCollection(9).Delete
    ActiveChart.SeriesCollection(8).Delete
    ActiveChart.SeriesCollection(7).Delete
    ActiveChart.SeriesCollection(6).Delete
    ActiveChart.SeriesCollection(5).Delete
    
    ActiveChart.SeriesCollection(4).Select
    Selection.MarkerStyle = -4142
    With Selection.Format.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(197, 40, 0)
    End With
    With Selection.Format.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
    End With
    With Selection.Format.Line
        .Visible = msoTrue
        .Weight = 1
    End With
    With Selection.Format.Line
        .Visible = msoTrue
        .DashStyle = msoLineSysDot
    End With
    With Selection.Format.Line
        .Visible = msoTrue
        .DashStyle = msoLineSysDash
    End With
    ActiveChart.SeriesCollection(3).Select
    Selection.MarkerStyle = -4142
    With Selection.Format.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
    End With
    With Selection.Format.Line
        .Visible = msoTrue
        .Weight = 1
    End With
    With Selection.Format.Line
        .Visible = msoTrue
        .DashStyle = msoLineSysDash
    End With
    ActiveChart.SeriesCollection(1).Select
    Selection.MarkerStyle = -4142
    With Selection.Format.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
    End With
    With Selection.Format.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 112, 192)
        .Transparency = 0
    End With
    With Selection.Format.Line
        .Visible = msoTrue
        .Weight = 1
    End With
    With Selection.Format.Line
        .Visible = msoTrue
        .DashStyle = msoLineDash
    End With
    ActiveChart.SeriesCollection(2).Select
    Selection.MarkerStyle = -4142
    With Selection.Format.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 112, 192)
    End With
    With Selection.Format.Line
        .Visible = msoTrue
        .Weight = 1
    End With
    With Selection.Format.Line
        .Visible = msoTrue
        .DashStyle = msoLineDash
    End With
    
    ' Drawing Client values
    ActiveChart.ChartArea.Select
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.SeriesCollection(5).XValues = "='Output Site'!$K$3"
    ActiveChart.SeriesCollection(5).Values = "='Output Site'!$N$3"
    ActiveChart.SeriesCollection(5).Name = "='Output Site'!$I$2:$I$3"
    ActiveChart.SeriesCollection(5).Select
    With Selection
        .MarkerStyle = 1
        .MarkerSize = 5
    End With
    Selection.MarkerStyle = 8
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 178, 0)
        .Solid
    End With
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 255, 0)
    End With
    With Selection.Format.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 112, 192)
    End With
End Sub

Time period reference

<colgroup><col width="64"></colgroup><tbody>
</tbody>
Overall cases rate

<colgroup><col width="64"></colgroup><tbody>
</tbody>
Expected cases # (adjusted to exposure)

<colgroup><col width="64"></colgroup><tbody>
</tbody>
Standard Error

<colgroup><col width="64"></colgroup><tbody>
</tbody>
Lower Limit 95%

<colgroup><col width="64"></colgroup><tbody>
</tbody>
Upper Limit 95%

<colgroup><col width="64"></colgroup><tbody>
</tbody>
Lower Limit 99.5%

<colgroup><col width="64"></colgroup><tbody>
</tbody>
Upper Limit 99.5%

<colgroup><col width="64"></colgroup><tbody>
</tbody>
City

<colgroup><col width="64"></colgroup><tbody>
</tbody>
Client No.

<colgroup><col width="64"></colgroup><tbody>
</tbody>
Exposure months

<colgroup><col width="64"></colgroup><tbody>
</tbody>
Observed minus expected

<colgroup><col width="64"></colgroup><tbody>
</tbody>

<tbody>
</tbody>


<tbody>
</tbody>
Any help is much appreciated.

<tbody>
</tbody>
 

Some videos you may like

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December

Watch MrExcel Video

Forum statistics

Threads
1,122,355
Messages
5,595,680
Members
414,008
Latest member
SNesbyCarr

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top