Results 1 to 14 of 14

Thread: Multiple charts

  1. #1
    3 Star Lounger
    Join Date
    Jul 2005
    Location
    Bahrain
    Posts
    373
    Thanks
    1
    Thanked 0 Times in 0 Posts

    Multiple charts

    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

  2. #2
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    You did not attach file....

    Steve

  3. #3
    3 Star Lounger
    Join Date
    Jul 2005
    Location
    Bahrain
    Posts
    373
    Thanks
    1
    Thanked 0 Times in 0 Posts
    hi Steve,
    i have now, please consider this file.
    Attached Files Attached Files
    Last edited by dubdub; 2011-06-16 at 08:45.

  4. #4
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    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

  5. #5
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    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

  6. #6
    3 Star Lounger
    Join Date
    Jul 2005
    Location
    Bahrain
    Posts
    373
    Thanks
    1
    Thanked 0 Times in 0 Posts
    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
    Last edited by dubdub; 2011-06-19 at 10:13.

  7. #7
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    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

  8. #8
    3 Star Lounger
    Join Date
    Jul 2005
    Location
    Bahrain
    Posts
    373
    Thanks
    1
    Thanked 0 Times in 0 Posts
    Steve,

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

    thanks in advance.

    dubdubsample Modified.xls

  9. #9
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    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

  10. #10
    3 Star Lounger
    Join Date
    Jul 2005
    Location
    Bahrain
    Posts
    373
    Thanks
    1
    Thanked 0 Times in 0 Posts
    I will, thanks gain Steve.

    dubdub

  11. #11
    3 Star Lounger
    Join Date
    Jul 2005
    Location
    Bahrain
    Posts
    373
    Thanks
    1
    Thanked 0 Times in 0 Posts

    Code error '1004'

    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

  12. #12
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    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

  13. #13
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    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

  14. #14
    3 Star Lounger
    Join Date
    Jul 2005
    Location
    Bahrain
    Posts
    373
    Thanks
    1
    Thanked 0 Times in 0 Posts
    I will try. Thanks.

    dubdub

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •