PDA

View Full Version : [SOLVED] 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

:think:

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 ":D"

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:dunno

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.

:doh: :dunno

What's your view..????


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

kbsudhir
07-03-2008, 03:04 PM
I am working on Office 2003. Anything to with teh version of office..???
:think:

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.

:bow: :bow:

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.

:dunno

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

:bow: :bow: :bow: :bow: :bow: :bow: :bow: :bow: :bow:

Andy Pope
07-05-2008, 04:37 AM
This revision uses the chart object the code creates.
I create a chart object rather than a chart sheet which get moved.


Sub OverallErrorPareto()
Dim rng As Range
Dim LastRow As Long
Dim rngOutput As Range

With ActiveSheet
LastRow = .Range("C2:D2").End(xlDown).Row
Set rng = Union(.Range("C2:D2").Resize(LastRow - 1), .Range("F2:F2").Resize(LastRow - 1))

Set rngOutput = .Range("D23:R52")
With .ChartObjects.Add(rngOutput.Left, rngOutput.Top, rngOutput.Width, rngOutput.Height).Chart
.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%"

With .Parent
With .Border
.Weight = 2
.LineStyle = -1
End With
.RoundedCorners = True
.Shadow = False
End With
With .ChartArea.Fill
.TwoColorGradient Style:=msoGradientDiagonalDown, Variant:=1
.Visible = True
.ForeColor.SchemeColor = 40
.BackColor.SchemeColor = 36
End With
With .Axes(xlValue)
.MinimumScale = 0
.MaximumScale = 80
.MinorUnit = 2
.MajorUnit = 10
.Crosses = xlCustom
.CrossesAt = 0
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
End With
.Axes(xlValue).MajorGridlines.Delete
With .SeriesCollection(1)
With .Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With
.Shadow = False
.InvertIfNegative = False
With .Fill
.TwoColorGradient Style:=msoGradientFromCorner, Variant:=1
.Visible = True
.ForeColor.SchemeColor = 17
.BackColor.SchemeColor = 2
End With
End With
With .SeriesCollection(2)
With .Border
.ColorIndex = 6
.Weight = xlThin
.LineStyle = xlContinuous
End With
.MarkerBackgroundColorIndex = 4
.MarkerForegroundColorIndex = 4
.MarkerStyle = xlCircle
.Smooth = False
.MarkerSize = 5
.Shadow = False
End With

End With
End With


End Sub