Multiple charts

Topic

New Reply

Dear all,

i need help to automate creating a separte chart for every item. the chart needs to be sized such that the figures will be readable and falls within the ploting area, sized to reflect the item data. sample is attached and in advance i appreciate any help.

dubdub

Reply | Quote

Replies

You did not attach file….

Steve

Reply | Quote

hi Steve,
i have now, please consider this file.

Reply | Quote

I would start by creating the chart with the macro recorder turned on. Then you have the chart objects and options defined for a particular one, with the proper sizes of fonts and areas.

Then generalize the chart for the ranges that define what you call an “item”. It can be hard-coded or determined at runtime.

Steve

Reply | Quote

Steve,thanks again,

I may be can do the first part as you suggested for one item, but i need your help in modifing the macro, to generalize it to account for the other items with consideration of Y axix variations.Deal.:whisper:

dubdub.

Reply | Quote

Steve,thanks again,

I may be can do the first part as you suggested for one item, but i need your help in modifing the macro, to generalize it to account for the other items with consideration of Y axix variations.Deal.:whisper:

dubdub.

hi Steve,

below is the best i can do (first macro), i know it is the easist part.
Sub MultiChart()
‘
‘ MultiChart Macro
‘ Macro recorded 16/06/2011 by free user
‘

‘
Range(“V2”).Select
Charts.Add
ActiveChart.ChartType = xlColumnClustered
ActiveChart.SetSourceData Source:=Sheets(“Sheet1”).Range(“V2”)
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(1).XValues = “=Sheet1!R2C8:R2C13”
ActiveChart.SeriesCollection(1).Values = “=Sheet1!R3C8:R3C13”
ActiveChart.SeriesCollection(1).Name = “=Sheet1!R3C2”
ActiveChart.SeriesCollection(2).Values = “=Sheet1!R4C8:R4C13”
ActiveChart.SeriesCollection(2).Name = “=Sheet1!R4C2”
ActiveChart.SeriesCollection(3).Values = “=Sheet1!R5C8:R5C13”
ActiveChart.SeriesCollection(3).Name = “=Sheet1!R5C2”
ActiveChart.SeriesCollection(4).Values = “=Sheet1!R6C8:R6C13”
ActiveChart.SeriesCollection(4).Name = “=Sheet1!R6C2″
ActiveChart.Location Where:=xlLocationAsObject, Name:=”Sheet1”
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = _
“(XXX1) 2011 – 2013 VAR 12-13 vs. 10-12”
.Axes(xlCategory, xlPrimary).HasTitle = False
.Axes(xlValue, xlPrimary).HasTitle = False
End With
ActiveChart.HasLegend = True
ActiveChart.Legend.Select
Selection.Position = xlTop
ActiveChart.ChartTitle.Select
Selection.Characters.Text = _
“(XXX1) 2011 – 2013 VAR” & Chr(10) & ” 12-13 vs. 10-12″
Selection.AutoScaleFont = False
With Selection.Characters(Start:=1, Length:=138).Font
.Name = “Arial”
.FontStyle = “Bold”
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
ActiveChart.ChartArea.Select
ActiveChart.Legend.Select
Selection.Left = 36
Selection.Width = 209
ActiveChart.Axes(xlValue).Select
With Selection.Border
.Weight = xlHairline
.LineStyle = xlAutomatic
End With
With Selection
.MajorTickMark = xlNone
.MinorTickMark = xlNone
.TickLabelPosition = xlNone
End With
ActiveChart.PlotArea.Select
ActiveChart.SeriesCollection(3).Select
ActiveChart.Axes(xlCategory).Select
With Selection.Border
.Weight = xlHairline
.LineStyle = xlAutomatic
End With
With Selection
.MajorTickMark = xlOutside
.MinorTickMark = xlNone
.TickLabelPosition = xlLow
End With
ActiveChart.PlotArea.Select
With Selection.Border
.ColorIndex = 16
.Weight = xlThin
.LineStyle = xlContinuous
End With
With Selection.Interior
.ColorIndex = 2
.PatternColorIndex = 1
.Pattern = xlSolid
End With
ActiveChart.Axes(xlValue).MajorGridlines.Select
With Selection.Border
.ColorIndex = 2
.Weight = xlHairline
.LineStyle = xlContinuous
End With
ActiveChart.PlotArea.Select
ActiveChart.Axes(xlValue).Select
With ActiveChart.Axes(xlValue)
.MinimumScaleIsAuto = True
.MaximumScale = 200
.MinorUnitIsAuto = True
.MajorUnitIsAuto = True
.Crosses = xlAutomatic
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
End With
With ActiveChart.Axes(xlValue)
.MinimumScale = -10
.MaximumScale = 200
.MinorUnitIsAuto = True
.MajorUnitIsAuto = True
.Crosses = xlAutomatic
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
End With
With ActiveChart.Axes(xlValue)
.MinimumScale = -20
.MaximumScale = 200
.MinorUnitIsAuto = True
.MajorUnitIsAuto = True
.Crosses = xlAutomatic
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
End With
With ActiveChart.Axes(xlValue)
.MinimumScale = -30
.MaximumScale = 200
.MinorUnitIsAuto = True
.MajorUnitIsAuto = True
.Crosses = xlAutomatic
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
End With
ActiveChart.SeriesCollection(4).DataLabels.Select
Selection.Font.Bold = True
ActiveChart.SeriesCollection(1).DataLabels.Select
Selection.Font.Bold = True
ActiveChart.SeriesCollection(3).DataLabels.Select
Selection.Font.Bold = True
ActiveChart.SeriesCollection(3).Select
ActiveChart.SeriesCollection(2).DataLabels.Select
Selection.Font.Bold = True
ActiveChart.Axes(xlCategory).Select
Selection.TickLabels.Font.Bold = True
ActiveChart.SeriesCollection(4).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With
Selection.Shadow = True
Selection.InvertIfNegative = False
Selection.Fill.OneColorGradient Style:=msoGradientHorizontal, Variant:=1, _
Degree:=0.231372549019608
With Selection
.Fill.Visible = True
.Fill.ForeColor.SchemeColor = 20
End With
ActiveChart.SeriesCollection(3).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With
Selection.Shadow = True
Selection.InvertIfNegative = False
Selection.Fill.OneColorGradient Style:=msoGradientHorizontal, Variant:=1, _
Degree:=0.231372549019608
With Selection
.Fill.Visible = True
.Fill.ForeColor.SchemeColor = 19
End With
ActiveChart.SeriesCollection(2).Select
ActiveChart.SeriesCollection(2).Points(4).Select
ActiveChart.PlotArea.Select
ActiveChart.SeriesCollection(2).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With
Selection.Shadow = True
Selection.InvertIfNegative = False
Selection.Fill.OneColorGradient Style:=msoGradientHorizontal, Variant:=1, _
Degree:=0.631357289997711
With Selection
.Fill.Visible = True
.Fill.ForeColor.SchemeColor = 18
End With
ActiveChart.SeriesCollection(1).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With
Selection.Shadow = True
Selection.InvertIfNegative = False
Selection.Fill.OneColorGradient Style:=msoGradientHorizontal, Variant:=1, _
Degree:=0.231372549019608
With Selection
.Fill.Visible = True
.Fill.ForeColor.SchemeColor = 17
End With
ActiveChart.Axes(xlCategory).Select
ActiveChart.ChartTitle.Select
Selection.Characters.Text = _
“(XXX1) 2011 – 2013 VAR” & Chr(10) & ” 12-13 vs. 10-12″
Selection.AutoScaleFont = False
With Selection.Characters(Start:=1, Length:=138).Font
.Name = “Arial”
.FontStyle = “Bold”
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
ActiveChart.ChartArea.Select
End Sub

Reply | Quote

dear all,

I still have hope…

Reply | Quote

It seems that your post with the code got deleted. Here is some code that loops through the data and creates multiple charts. Modify the formatting of the chart as desired. Other than the looping through the items, the other change was adding a text box to create 2 “titles” rather than adding the spacing to make the 1 title act as 2 titles.

It should be relatively straightforward to find the correct section to modify the code to alter the formatting some more. If nothing else, record the macro with the changes, and see what objects are changed in the recording and search for the object in this code.

Steve

Code:

Option Explicit
Sub AddCharts()
  Dim wks As Worksheet
  Dim lStartRow As Long
  Dim rItem As Range
  Dim rXHeader As Range
  Dim rYHeader As Range
  Dim rX As Range, rY As Range
  Dim iRows As Integer
  Dim iColY As Integer
  Dim iColsY As Integer
  Dim sTitle As String
  Dim sTitle1 As String
  Dim sTitle2 As String
  Dim cht As Chart
  Dim iColChart As Integer
  Dim lTop As Long
  Dim lGap As Long
  Dim shp As Shape
  Dim x As Integer
  
  Application.ScreenUpdating = False
'define initial items
  iRows = 4 '4 rows (bar, jar, car, all)
  iColY = 7 ' Col H is 7 from Col A
  iColsY = 6 '6 cols (2011, 2012, 2013, total, like, total)
  iColChart = 5 'Chart's left edge will be Col E
  lGap = 3 'Gap between charts
  Set wks = ActiveSheet
  With wks
    Set rItem = .Range("A3")
    Set rXHeader = .Range("B2")
    Set rYHeader = .Range("H2:M2")
    sTitle = .Range("H1")
    sTitle2 = .Range("O1")
  
'calculate position of first chart, 2 rows from last datarow
    lStartRow = .Cells(.Rows.Count, 1).End(xlUp).Row + iRows + 2
'Top of first chart
    lTop = .Cells(lStartRow, iColChart).Top
  End With
'Add linespace to 2nd Title
  sTitle2 = Application.WorksheetFunction. _
    Substitute(sTitle2, "VAR ", "VAR" & Chr(10))
'loop through the item list
  Do While rItem.Value  ""
    'Add item to 1st Title
    sTitle1 = "(" & rItem & ") " & sTitle
    'get chart ranges
    Set rX = wks.Range(rItem.Offset(0, 1), rItem.Offset(iRows - 1, 1))
    Set rY = wks.Range(rItem.Offset(0, iColY), _
      rItem.Offset(iRows - 1, iColY + iColsY - 1))
    Charts.Add
    ActiveChart.Location _
      Where:=xlLocationAsObject, Name:=wks.Name
    Set cht = ActiveChart
'Formatting from your code
'remove unneccessary items
    With cht
      .ChartType = xlColumnClustered
      .SetSourceData Source:=Union(rXHeader, rYHeader, rX, rY), _
        PlotBy:=xlRows
      .Parent.Left = wks.Cells(lStartRow, iColChart).Left
      .Parent.Top = lTop
      lTop = lTop + .Parent.Height + lGap
      For x = 1 To iRows
        With cht.SeriesCollection(x)
          .ApplyDataLabels Type:=xlDataLabelsShowValue
          .DataLabels.Font.Bold = True
          With .Border
            .Weight = xlThin
            .LineStyle = xlAutomatic
          End With
          .Shadow = True
          .InvertIfNegative = False
          .Fill.OneColorGradient _
            Style:=msoGradientHorizontal, Variant:=1, _
            Degree:=0.231372549019608
          .Fill.Visible = True
          .Fill.ForeColor.SchemeColor = 16 + x
        End With
      Next
      .HasTitle = True
      With .ChartTitle
        .Left = 75
        .Top = 5
        .AutoScaleFont = False
        With .Characters
          .Text = sTitle1
          With .Font
            .Name = "Arial"
            .FontStyle = "Bold"
            .Size = 12
            .ColorIndex = xlAutomatic
          End With
        End With
      End With
      Set shp = .Shapes.AddTextbox _
        (msoTextOrientationHorizontal, 250, 5, 1, 1)
      With shp
        With .TextFrame
          .AutoSize = True
          .HorizontalAlignment = xlHAlignCenter
          With .Characters
            .Text = sTitle2
            With .Font
              .Name = "Arial"
              .FontStyle = "Bold"
              .Size = 12
              .ColorIndex = xlAutomatic
            End With
          End With
        End With
      End With
      
      .HasLegend = True
      With .Legend
        .Position = xlTop
        .Left = 36
        .Width = 209
      End With
      With .Axes(xlValue)
        .MinimumScale = -30
        .MaximumScale = 300
        .MinorUnitIsAuto = True
        .MajorUnitIsAuto = True
        .Crosses = xlAutomatic
        .ReversePlotOrder = False
        .ScaleType = xlLinear
        .DisplayUnit = xlNone
        .MajorTickMark = xlNone
        .MinorTickMark = xlNone
        .TickLabelPosition = xlNone
        With .MajorGridlines
          With .Border
            .ColorIndex = 2
            .Weight = xlHairline
            .LineStyle = xlContinuous
          End With
        End With
        With .Border
          .Weight = xlHairline
          .LineStyle = xlAutomatic
        End With
      End With
      
      With .Axes(xlCategory)
        .MajorTickMark = xlOutside
        .MinorTickMark = xlNone
        .TickLabelPosition = xlLow
        .TickLabels.Font.Bold = True
        With .Border
          .Weight = xlHairline
          .LineStyle = xlAutomatic
        End With
      End With
      With .PlotArea
        .Width = 328
        With .Border
          .ColorIndex = 16
          .Weight = xlThin
          .LineStyle = xlContinuous
        End With
        With .Interior
          .ColorIndex = 2
          .PatternColorIndex = 1
          .Pattern = xlSolid
        End With
      End With
    End With
    Set rItem = rItem.Offset(iRows, 0)
  Loop
  Application.ScreenUpdating = True
  Set rItem = Nothing
End Sub

Reply | Quote

Dr. Steve,

Thank you very very much, as always with someone like you there is hope.

One more thing when i add two more years the second title disappears.any quick remedy to have flexibility here. If you allow me can i ask you to reconsider accepting messages.

dubdub

Reply | Quote

What do you mean by disapears? If it is location of the Title2 you can change the left (250) and top (5):

Set shp = .Shapes.AddTextbox _
(msoTextOrientationHorizontal, 250, 5, 1, 1)

Steve

Reply | Quote

Steve,

The attchement has the modifications i made to the data, and the columns n-s plus the second title disappears.

thanks in advance.

dubdub28228-sample-Modified

Reply | Quote

It does not disappear, you just don’t have any text in it. The 2nd title is seeded with the line:

sTitle2 = .Range(“O1”)

You do not have anything in O1. You moved the contents of O1 to V1, so you must change the line of code to:
sTitle2 = .Range(“V1”)

to get the VAR line…

I would recommend before you do too much changing that you start with the original workbook and the original code and make sure you understand what each of the lines are doing (you can step thru the code to watch it change if you comment out the line:
‘Application.ScreenUpdating = False

Some of the formatting you may not need to explicitly set, I took the code from your formatting.

Once you understand the code, you can start modifying the workbook and understand the effect on the code and where the code needs to be changed to adjust for those changes….

Steve

Reply | Quote

I will, thanks gain Steve.

dubdub

Reply | Quote

Hi Steve,

I made the following changes in the code and i got run time error ‘1004’ unable to set the Name property of the font class:
iRows = 3 ‘3 rows (bar, jar, car, all)
iColY = 9 ‘ Col H is 9 from Col A
iColsY = 12 ’12 cols (2011, 2012, 2013, total, like, total)
iColChart = 22 ‘Chart’s left edge will be Col V
lGap = 3 ‘Gap between charts
Set wks = ActiveSheet
With wks
Set rItem = .Range(“A3”)
Set rXHeader = .Range(“B2”)
Set rYHeader = .Range(“I2:T2”)
sTitle = .Range(“I1”)
sTitle2 = .Range(“O1”)

dubdub

Reply | Quote

None of those lines should give that error. Which line gives the error and under what circumstances
Based on the changes you list, it seems you have made changes to the worksheet. It may be easier to troubleshoot if you attach a new sample file with the new setup with the new code demonstrating the error.

One thing I notice, If the data starts in col J (9 cols from A) why does rYheader use Cols I -T, instead of J-U?

Note: Not important to the code, but for later understanding, If you change the values, you may want to change the comments to match the new values: There are 4 items for 3 rows, Col J is 9 cols from A, you only list 6 cols when you state there are 12.

Steve

Reply | Quote

Hi Steve,

I was able to fix it, applying what you have suggested above. The plots become very crowded, i know i am asking too much but i would highly appreciate if you can help split the plots into two as depcited in the attachment. no problem if you have other suggestion to make it more professional.

dubdub

Reply | Quote

You should be able to modify the code that I provided to do this. For each loop instead of creating 1 chart, copy the code and modify it to create a 2nd chart using new variable names for the 2nd chart. You can get rid of text box for the 2nd title I created.

Steve

Reply | Quote

I will try. Thanks.

dubdub

Reply | Quote