Microsoft Office Forums - View Single Post

dccjr · 04-12-2013, 09:03 PM

I have a function (thanks Jeremy Zerr) that automates the chart creation for my app. I am not sure how to modify it to my purposes. It charts each of the row from my data sheet, and I want it to chart all of them. Can anyone help, or even expand which section I should look at. It has pretty good comments, but an not sure where to start.

Code:

FunctionCreateBarCharts() AsBoolean
    DimmyChtObj AsChartObject 
    DimrngChtData AsRange 
    DimrngChtXVal AsRange 
    DimiColumn AsLong

    DimsheetName AsString
    sheetName = "DataSource"
    DimWSD AsWorksheet 
    SetWSD = Worksheets(sheetName) 

    DimchartSheet AsString
    chartSheet = "ChartOutput"
    DimCSD AsWorksheet 
    SetCSD = Worksheets(chartSheet) 

    ' get the current charts so proper overwriting can happen 
    DimchtObjs AsChartObjects 
    SetchtObjs = CSD.ChartObjects 

    ' Turn off autofilter mode 
    WSD.AutoFilterMode = False

    ' Find the last row with data 
    DimfinalRow AsLong
    finalRow = WSD.Cells(Application.Rows.Count, 1).End(xlUp).Row 

    Dimi AsInteger

    ' for each row in the sheet 
    Fori = 2 TofinalRow 

        DimchartName AsString
        chartName = WSD.Cells(i, 5).Value 

        ' Delete chart if it already exists, we are making a new one 
        DimchtObj AsChartObject 
        ForEachchtObj InchtObjs 
            IfchtObj.Name = chartName Then
                chtObj.Delete 
            EndIf
        Next

        ' define chart data range for the row (record) 
        DimdataString AsString
        dataString = "C"& i & ":D"& i 
        SetrngChtData = WSD.Range(dataString) 

        ' define the x values 
        SetrngChtXVal = WSD.Range("$C$1:$D$1") 

        ' add the chart 
        Charts.Add 
        WithActiveChart 

            ' make a bar chart 
            .ChartType = xlColumnClustered 

            ' remove extra series 
            DoUntil.SeriesCollection.Count = 0 
                .SeriesCollection(1).Delete 
            Loop


 
           ' add series from selected range, column by column 

            With.SeriesCollection.NewSeries 
                .Values = rngChtData 
                .XValues = rngChtXVal 
                .Name = "Cost"
            EndWith

            .Location Where:=xlLocationAsObject, Name:=chartSheet 
        EndWith
        WithActiveChart 
            .HasTitle = True
            .ChartTitle.Characters.Text = "Benefits Cost"
            .Parent.Name = WSD.Cells(i, 5).Value 
            .Legend.Delete 

            .Axes(xlCategory).TickLabels.AutoScaleFont = False
            With.Axes(xlCategory).TickLabels.Font 
                .Name = "Arial"
                .FontStyle = "Regular"
                .Size = 10 
                .Strikethrough = False
                .Superscript = False
                .Subscript = False
                .OutlineFont = False
                .Shadow = False
                .Underline = xlUnderlineStyleNone 
                .ColorIndex = xlAutomatic 
                .Background = xlAutomatic 
            EndWith

            .Axes(xlValue).TickLabels.AutoScaleFont = False
            With.Axes(xlValue).TickLabels.Font 
                .Name = "Arial"
                .FontStyle = "Regular"
                .Size = 8 
                .Strikethrough = False
                .Superscript = False
                .Subscript = False
                .OutlineFont = False
                .Shadow = False
                .Underline = xlUnderlineStyleNone 
                .ColorIndex = xlAutomatic 
                .Background = xlAutomatic 
            EndWith

            .ChartTitle.AutoScaleFont = False
            With.ChartTitle.Font 
                .Name = "Arial"
                .FontStyle = "Bold"
                .Size = 12 
                .Strikethrough = False
                .Superscript = False
                .Subscript = False
                .OutlineFont = False
                .Shadow = False
                .Underline = xlUnderlineStyleNone 
                .ColorIndex = xlAutomatic 
                .Background = xlAutomatic 
            EndWith

            With.PlotArea.Interior 
                .ColorIndex = 2 
                .PatternColorIndex = 1 
                .Pattern = xlSolid 
            EndWith
        EndWith

        ' Set the height and width 
        WithCSD.ChartObjects(chartName) 
            .Width = 225 
            .Height = 175 
        EndWith
    Nexti 
EndFunction

I would appreciate any advice. Thanks.