Creating Pareto Chart

**kbsudhir** · 07-03-2008, 09:50 AM

Hi All,

I want to create a pareto chart through VBA.
For that I am using custom chart of type - "Line - Column on 2 Axes"

This is the macro which i recorded -

Range("C2: D2").Select
Range(Selection, Selection.End(xlDown)).Select
Range("C2: D17,F2:F17").Select
Range("F2").Activate
Charts.Add
ActiveChart.ApplyCustomType ChartType:=xlBuiltIn, TypeName:= _
"Line - Column on 2 Axes"
ActiveChart.SetSourceData Source:=Sheets("Associates").Range("C2: D17,F2:F17") _
, PlotBy:=xlColumns
ActiveChart.Location Where:=xlLocationAsObject, Name:="Associates"
With ActiveChart
   .HasTitle = True
   .ChartTitle.Characters.Text = "Error"
   .Axes(xlCategory, xlPrimary).HasTitle = True
   .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "CS"
   .Axes(xlValue, xlPrimary).HasTitle = True
   .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Error#"
   .Axes(xlCategory, xlSecondary).HasTitle = False
   .Axes(xlValue, xlSecondary).HasTitle = True
   .Axes(xlValue, xlSecondary).AxisTitle.Characters.Text = "Cum%"
End With

Here source is static i.e ActiveChart.SetSourceData Source:=Sheets("Associates").Range("C2: D17,F2:F17") _
, PlotBy:=xlColumns

I want to make it dynamic. The required data will remain in colomn C,D & F
but the number of rows will keep on changing.

So how to insert the dynamic source here.

Thanks
Sudhir

**kbsudhir** · 07-03-2008, 09:53 AM

I have give space after ex "C2: " before D because otherwise it was giving a smilie. instead of "

"

**Bob Phillips** · 07-03-2008, 10:03 AM

Untested

Dim LastRow As Long
Dim rng As Range
With Worksheets("Associates")
   LastRow = .Range("C2:D2").End(xlDown).Row
   Set rng = Union(.Range("C2:D2").Resize(LastRow - 1), .Range("F2:F2").Resize(LastRow - 1))
   Charts.Add
   With ActiveChart
      .ApplyCustomType ChartType:=xlBuiltIn, _
      TypeName:="Line - Column on 2 Axes"
      .SetSourceData Source:=rng.Address(, , , True), _
      PlotBy:=xlColumns
      .Location Where:=xlLocationAsObject, Name:="Associates"
      .HasTitle = True
      .ChartTitle.Characters.Text = "Error"
      .Axes(xlCategory, xlPrimary).HasTitle = True
      .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "CS"
      .Axes(xlValue, xlPrimary).HasTitle = True
      .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Error#"
      .Axes(xlCategory, xlSecondary).HasTitle = False
      .Axes(xlValue, xlSecondary).HasTitle = True
      .Axes(xlValue, xlSecondary).AxisTitle.Characters.Text = "Cum%"
    End With
End Sub

**kbsudhir** · 07-03-2008, 11:50 AM

I am using the same code which you have provided but getting a type mismatch error at rng.address.

I tried a lot but not able to sort it out. What am I doing wrong.

Sub Chart()
Dim LastRow As Long
Dim rng As Range
With Worksheets("Associates")
   LastRow = .Range("C2:D2").End(xlDown).Row
   Set rng = Union(.Range("C2:D2").Resize(LastRow - 1), .Range("F2:F2").Resize(LastRow - 1))
   Charts.Add
   With ActiveChart
      .ApplyCustomType ChartType:=xlBuiltIn, _
      TypeName:="Line - Column on 2 Axes"
      .SetSourceData Source:=rng.Address(, , , True), _
      PlotBy:=xlColumns
      .Location Where:=xlLocationAsObject, Name:="Associates"
      .HasTitle = True
      .ChartTitle.Characters.Text = "Error"
      .Axes(xlCategory, xlPrimary).HasTitle = True
      .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "CS"
      .Axes(xlValue, xlPrimary).HasTitle = True
      .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Error#"
      .Axes(xlCategory, xlSecondary).HasTitle = False
      .Axes(xlValue, xlSecondary).HasTitle = True
      .Axes(xlValue, xlSecondary).AxisTitle.Characters.Text = "Cum%"
   End With
End With
End Sub

**kbsudhir** · 07-03-2008, 12:03 PM

If I remove .Address(,,,true) then I get "Automation error" in the line

.HasTitle = True

Please guide

Sudhir

**Bob Phillips** · 07-03-2008, 01:05 PM

Sub Chart()
    Dim LastRow As Long
    Dim rng As Range
With Worksheets("Associates")
LastRow = .Range("C2:D2").End(xlDown).Row
        Set rng = Union(.Range("C2:D2").Resize(LastRow - 1), .Range("F2:F2").Resize(LastRow - 1))
        Charts.Add
        With ActiveChart
.ApplyCustomType ChartType:=xlBuiltIn, _
            TypeName:="Line - Column on 2 Axes"
            .SetSourceData Source:=rng, _
            PlotBy:=xlColumns
            .HasTitle = True
            .ChartTitle.Characters.Text = "Error"
            With .Axes(xlCategory, xlPrimary)
.HasTitle = True
                .AxisTitle.Characters.Text = "Error#"
            End With
            With .Axes(xlValue, xlPrimary)
.HasTitle = True
                .AxisTitle.Characters.Text = "Cum%"
            End With
            .Location Where:=xlLocationAsObject, Name:="Associates"
        End With
    End With
End Sub

**kbsudhir** · 07-03-2008, 02:20 PM

Thanks XLD, But now I am really facing a peculiar problem.

When I run the code for the first time I get Error "Run time error: 1004"
Method "Axes" of object '_chart' failed.

I end the code. I find that one chart is created partially.

But when run the code again without deleting the partially created chart it works absolutely fine ...!!!!!!!!!!! But if I delete teh partially created fine then I get the same error
And creates the chart completely in the Sheets("associates").

I just made one change. I changed the second

With .Axes(xlCategory, xlPrimary)

to

With .Axes(xlValue, xlSecondary)

Sub Chart()
Dim LastRow As Long
Dim rng As Range
With Worksheets("Associates")
   LastRow = .Range("C2:D2").End(xlDown).Row
   Set rng = Union(.Range("C2:D2").Resize(LastRow - 1), .Range("F2:F2").Resize(LastRow - 1))
   Charts.Add
   With ActiveChart
      .ApplyCustomType ChartType:=xlBuiltIn, _
      TypeName:="Line - Column on 2 Axes"
      .SetSourceData Source:=rng, _
      PlotBy:=xlColumns
      .HasTitle = True
      .ChartTitle.Characters.Text = "Error"
      With .Axes(xlCategory, xlPrimary)
         .HasTitle = True
         .AxisTitle.Characters.Text = "Error#"
      End With
      With .Axes(xlValue, xlSecondary)
         .HasTitle = True
         .AxisTitle.Characters.Text = "Cum%"
      End With
      .Location Where:=xlLocationAsObject, Name:="Associates"
   End With
End With
End Sub

Where am I gone wrong..????

Sudhir

**Bob Phillips** · 07-03-2008, 02:23 PM

Why did you change that, you don't have a secondary axis.

**Bob Phillips** · 07-03-2008, 02:30 PM

I see what is going on now, even if not why.

When the first one is created it is a standard column chart, not a custom type. But then when you rerun, it creates the custom type.

Time to play some more.

**Bob Phillips** · 07-03-2008, 02:39 PM

This seems to work

Dim rng As Range
Dim LastRow As Long
With ActiveSheet
   LastRow = .Range("C2:D2").End(xlDown).Row
   Set rng = Union(.Range("C2:D2").Resize(LastRow - 1), .Range("F2:F2").Resize(LastRow - 1))
    End With
Charts.Add
    With ActiveChart
   .ApplyCustomType ChartType:=xlBuiltIn, TypeName:="Line - Column on 2 Axes"
   .SetSourceData Source:=rng, PlotBy:=xlColumns
   .HasTitle = True
   .ChartTitle.Characters.Text = "Error"
   .Axes(xlCategory, xlPrimary).HasTitle = True
   .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "CS"
   .Axes(xlValue, xlPrimary).HasTitle = True
   .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Error#"
   .Axes(xlCategory, xlSecondary).HasTitle = False
   .Axes(xlValue, xlSecondary).HasTitle = True
   .Axes(xlValue, xlSecondary).AxisTitle.Characters.Text = "Cum%"
   .Location Where:=xlLocationAsObject, Name:="Associates"
    End With

**kbsudhir** · 07-03-2008, 02:56 PM

This time I used the cod as is But I am getting The error "Run time error: 1004"
Method "Axes" of object '_chart' failed.

.Axes(xlCategory, xlSecondary).HasTitle = False

I think its only creating a standard single Y axis chart instead of dual Y axis chart as coded in chart type.

What's your view..????

But its getting really interesting now & confusing also for me.

**kbsudhir** · 07-03-2008, 03:04 PM

I am working on Office 2003. Anything to with teh version of office..???

**Bob Phillips** · 07-03-2008, 03:30 PM

Darn, me too now. Will look again tomorrow.

**Andy Pope** · 07-04-2008, 05:55 AM

This use a standard chart type, rather than custom, and formats the chart type for the line.

Sub x()
    Dim rng As Range
    Dim LastRow As Long
With ActiveSheet
   LastRow = .Range("C2:D2").End(xlDown).Row
   Set rng = Union(.Range("C2:D2").Resize(LastRow - 1), .Range("F2:F2").Resize(LastRow - 1))
    End With
    Charts.Add
    With ActiveChart
   .ApplyCustomType ChartType:=XlChartType.xlColumnClustered
   .SetSourceData Source:=rng, PlotBy:=xlColumns
   With .SeriesCollection(2)
      .ChartType = xlLineMarkers
      .AxisGroup = 2
   End With
   .HasTitle = True
   .ChartTitle.Characters.Text = "Error"
   .Axes(xlCategory, xlPrimary).HasTitle = True
   .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "CS"
   .Axes(xlValue, xlPrimary).HasTitle = True
   .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Error#"
   .Axes(xlCategory, xlSecondary).HasTitle = False
   .Axes(xlValue, xlSecondary).HasTitle = True
   .Axes(xlValue, xlSecondary).AxisTitle.Characters.Text = "Cum%"
   .Location Where:=xlLocationAsObject, Name:="Associates"
End With
End Sub

**kbsudhir** · 07-04-2008, 06:49 AM

Hi Andy,

Its giving me an error Compile Error: Method or Data Member not found at

Charts.Add

What am I doing wrong...???
Focus is on the correct sheet.

Sudhir

**Andy Pope** · 07-04-2008, 07:08 AM

It's can not be the code as your original had the same line.

Do you have something called Charts?

**mdmackillop** · 07-04-2008, 07:23 AM

Check for missing references (Tools/References). Remove the check mark from any missing items.

**kbsudhir** · 07-04-2008, 07:24 AM

Yeah, I got it now. I should get the fool of the year award if there is one.
The name of the moduel was "charts", I changedit to chart & its working now.

Now I am trying to format the chart i.e color combination and all that kind of stuff.

Thanks for all your help XLD & Andy so that I reached till here.

**kbsudhir** · 07-04-2008, 07:28 AM

As I wrote earlier, I am formating my chart here is the code

ActiveSheet.Shapes("Chart 28").IncrementLeft -88.5
    ActiveSheet.Shapes("Chart 28").IncrementTop 125.25
    ActiveSheet.Shapes("Chart 28").ScaleWidth 1.58, msoFalse, msoScaleFromTopLeft
    ActiveSheet.Shapes("Chart 28").ScaleHeight 1.25, msoFalse, msoScaleFromTopLeft
    With Selection.Border
   .Weight = 2
   .LineStyle = -1
End With
    Sheets("Associates").DrawingObjects("Chart 28").RoundedCorners = True
    Sheets("Associates").DrawingObjects("Chart 28").Shadow = False
    Selection.Fill.TwoColorGradient Style:=msoGradientDiagonalDown, Variant:=1
    With Selection
   .Fill.Visible = True
   .Fill.ForeColor.SchemeColor = 40
   .Fill.BackColor.SchemeColor = 36
    End With
    ActiveChart.Axes(xlValue).MajorGridlines.Select
    With ActiveChart.Axes(xlValue)
   .MinimumScale = 0
   .MaximumScale = 80
   .MinorUnit = 2
   .MajorUnit = 10
   .Crosses = xlCustom
   .CrossesAt = 0
   .ReversePlotOrder = False
   .ScaleType = xlLinear
   .DisplayUnit = xlNone
    End With
    ActiveChart.Axes(xlValue).MajorGridlines.Select
    Selection.Delete
    ActiveChart.PlotArea.Select
    ActiveChart.SeriesCollection(1).Select
    With Selection.Border
   .Weight = xlThin
   .LineStyle = xlAutomatic
    End With
    Selection.Shadow = False
    Selection.InvertIfNegative = False
    Selection.Fill.TwoColorGradient Style:=msoGradientFromCorner, Variant:=1
    With Selection
   .Fill.Visible = True
   .Fill.ForeColor.SchemeColor = 17
   .Fill.BackColor.SchemeColor = 2
    End With
    ActiveChart.SeriesCollection(2).Select
    With Selection.Border
   .ColorIndex = 6
   .Weight = xlThin
  .LineStyle = xlContinuous
    End With
    With Selection
   .MarkerBackgroundColorIndex = 4
   .MarkerForegroundColorIndex = 4
   .MarkerStyle = xlCircle
   .Smooth = False
   .MarkerSize = 5
   .Shadow = False
    End With
    ActiveChart.PlotArea.Select
End Sub

Here

ActiveSheet.Shapes("Chart 28").IncrementTop 125.25
    ActiveSheet.Shapes("Chart 28").ScaleWidth 1.58, msoFalse, msoScaleFromTopLeft
    ActiveSheet.Shapes("Chart 28").ScaleHeight 1.25, msoFalse, msoScaleFromTopLeft

And

Sheets("Associates").DrawingObjects("Chart 28").RoundedCorners = True
    Sheets("Associates").DrawingObjects("Chart 28").Shadow = False

Are two parts of the code which are static.
I want to learn what should I do to make this dynamic.

Thanks
Sudhir

**kbsudhir** · 07-04-2008, 07:53 AM

I sorted it out

Below code is how I did it.

Dim chr, sht, data As String
data = ActiveChart.name
sht = ActiveSheet.name
chr = Trim(Replace(data, sht, ""))

I captured the name in chr variable & replaced it with the name of the chart in the static part of the code.

The static part of the code now looks like this.

ActiveSheet.Shapes(chr).IncrementLeft -88.5
ActiveSheet.Shapes(chr).IncrementTop 125.25
ActiveSheet.Shapes(chr).ScaleWidth 1.58, msoFalse, msoScaleFromTopLeft
ActiveSheet.Shapes(chr).ScaleHeight 1.25, msoFalse, msoScaleFromTopLeft

And

Sheets("Associates").DrawingObjects(chr).RoundedCorners = True
Sheets("Associates").DrawingObjects(chr).Shadow = False

Even though I am marking this thread as solved, If anyone know a better approach, please let me know.

My Whole Code now looks like this.

Sub OverallErrorPareto()
Dim rng As Range
Dim LastRow As Long
With ActiveSheet
   LastRow = .Range("C2:D2").End(xlDown).Row
   Set rng = Union(.Range("C2:D2").Resize(LastRow - 1), .Range("F2:F2").Resize(LastRow - 1))
End With
Charts.Add
With ActiveChart
   .ApplyCustomType ChartType:=XlChartType.xlColumnClustered
   .SetSourceData Source:=rng, PlotBy:=xlColumns
   With .SeriesCollection(2)
      .ChartType = xlLineMarkers
      .AxisGroup = 2
   End With
   .HasTitle = True
   .ChartTitle.Characters.Text = "Error"
   .Axes(xlCategory, xlPrimary).HasTitle = True
   .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "CS"
   .Axes(xlValue, xlPrimary).HasTitle = True
   .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Error#"
   .Axes(xlCategory, xlSecondary).HasTitle = False
   .Axes(xlValue, xlSecondary).HasTitle = True
   .Axes(xlValue, xlSecondary).AxisTitle.Characters.Text = "Cum%"
   .Location Where:=xlLocationAsObject, name:="Associates"
End With
Dim chr, sht, data As String
data = ActiveChart.name
sht = ActiveSheet.name
chr = Trim(Replace(data, sht, ""))
ActiveSheet.Shapes(chr).IncrementLeft -88.5
ActiveSheet.Shapes(chr).IncrementTop 125.25
ActiveSheet.Shapes(chr).ScaleWidth 1.58, msoFalse, msoScaleFromTopLeft
ActiveSheet.Shapes(chr).ScaleHeight 1.25, msoFalse, msoScaleFromTopLeft
With Selection.Border
   .Weight = 2
   .LineStyle = -1
End With
Sheets("Associates").DrawingObjects(chr).RoundedCorners = True
Sheets("Associates").DrawingObjects(chr).Shadow = False
Selection.Fill.TwoColorGradient Style:=msoGradientDiagonalDown, Variant:=1
With Selection
   .Fill.Visible = True
   .Fill.ForeColor.SchemeColor = 40
   .Fill.BackColor.SchemeColor = 36
End With
ActiveChart.Axes(xlValue).MajorGridlines.Select
With ActiveChart.Axes(xlValue)
   .MinimumScale = 0
   .MaximumScale = 80
   .MinorUnit = 2
   .MajorUnit = 10
   .Crosses = xlCustom
   .CrossesAt = 0
   .ReversePlotOrder = False
   .ScaleType = xlLinear
   .DisplayUnit = xlNone
End With
ActiveChart.Axes(xlValue).MajorGridlines.Select
Selection.Delete
ActiveChart.PlotArea.Select
ActiveChart.SeriesCollection(1).Select
With Selection.Border
   .Weight = xlThin
   .LineStyle = xlAutomatic
End With
Selection.Shadow = False
Selection.InvertIfNegative = False
Selection.Fill.TwoColorGradient Style:=msoGradientFromCorner, Variant:=1
With Selection
   .Fill.Visible = True
   .Fill.ForeColor.SchemeColor = 17
   .Fill.BackColor.SchemeColor = 2
End With
ActiveChart.SeriesCollection(2).Select
With Selection.Border
   .ColorIndex = 6
   .Weight = xlThin
   .LineStyle = xlContinuous
End With
With Selection
   .MarkerBackgroundColorIndex = 4
   .MarkerForegroundColorIndex = 4
   .MarkerStyle = xlCircle
   .Smooth = False
   .MarkerSize = 5
   .Shadow = False
End With
ActiveChart.PlotArea.Select
End Sub

Its also working smoothly.

Thanks Xld, Andy and Mdmackillop for all your time, help & guidance.

Sudhir

Thread: Creating Pareto Chart

Thread Tools

Display

Creating Pareto Chart

Posting Permissions