Pareto Chart in Excel

Pareto Chart in Excel
Creating pareto chart in excel requires multiple steps as there is no direct method to accomplish this in excel. Here’s a vba a script that creates a pareto chart in excel.

How to use the script?
Select the data and run the ParetoChart sub. That’s it. The scripts always assumes the first row is headers. Don’t forget that.

And if you need Boxplot in excel, this is where you should go.

Here’s the code….


Sub ParetoChart()
Dim rRange As range

    On Error Resume Next

    Application.DisplayAlerts = False

            Set rRange = Application.InputBox(Prompt:= _
                "Please select a range with your Mouse to Plot Pareto Chart.", _
                    Title:="SPECIFY RANGE", Type:=8)


       If rRange Is Nothing Then
            Exit Sub
        Else
            Call Calculate(rRange)
            Call CreateGraph(rRange)

        End If
   Application.DisplayAlerts = True
          
End Sub



Sub Calculate(myrange)
Dim mrange As range
Dim mstr As String
Dim sstr As String

rr = myrange.Row
rrc = myrange.Rows.Count
cc = myrange.Column

Set mrange = range(Cells(rr + 1, cc + 1), Cells(rr + rrc - 1, cc + 1))


mstr = "R" + LTrim(Str(rr + rrc - 1)) + "C" + LTrim(Str(cc + 2))
sstr = "R" + LTrim(Str(rr + 1)) + "C" + LTrim(Str(cc + 1))


  
    myrange.Select
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=mrange _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.ActiveSheet.Sort
        .SetRange myrange
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    Cells(rr, cc + 2) = "CUMSUM"
    Cells(rr + 1, cc + 2).FormulaR1C1 = "=RC[-1]"
    
    For ii = rr + 2 To rr + rrc - 1
     Cells(ii, cc + 2).FormulaR1C1 = "=SUM(" + sstr + ":RC[-1])"
    Next ii
    
    Cells(rr, cc + 3).FormulaR1C1 = "%"
    
    
    For ii = rr + 1 To rr + rrc - 1
     Cells(ii, cc + 3).FormulaR1C1 = "=RC[-1]/" + mstr
    Next ii
    
    range(Cells(rr + 1, cc + 3), Cells(rr + rrc - 1, cc + 3)).Select
    Selection.NumberFormat = "0%"
   
End Sub





Sub CreateGraph(myrange)
    Dim tran As range
    
    rr = myrange.Row
    cc = myrange.Column
    rrc = myrange.Rows.Count

    
    Set tran = range(Cells(rr + 1, cc + 3), Cells(rr + rrc - 1, cc + 3))
    
    
    myrange.Select
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.SetSourceData Source:=myrange
    ActiveChart.ChartType = xlColumnClustered
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.SeriesCollection(2).Name = "%"
    ActiveChart.SeriesCollection(2).Values = tran
    ActiveChart.Legend.Select

    ActiveChart.Legend.LegendEntries(2).Select

    ActiveChart.SeriesCollection(2).ChartType = xlLine
    ActiveChart.Legend.Select
    
    ActiveChart.Legend.LegendEntries(2).Select
   
    ActiveChart.SeriesCollection(2).Select
    ActiveChart.SeriesCollection(2).AxisGroup = 2
    
    ActiveChart.Axes(2).MajorGridlines.Format.Line.Transparency = 0.8
     
    ActiveChart.ChartArea.Width = 640
    ActiveChart.ChartArea.Height = 300
    
    
    ActiveChart.Legend.Width = 200
    ActiveChart.Legend.Select
    
    Selection.Left = 400
    Selection.Top = 10
    
    
    ActiveChart.Axes(xlValue).MajorGridlines.Format.Line.Transparency = 0.8
    
    Set tran = Nothing
    
End Sub



Advertisements

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s