Chart code for automation

dccjr · #1 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.

OTPM · #2 04-15-2013, 06:26 AM

Hi
From what I can see it Charts every row in your datasheet so I am not sure what you want to change.

However if your datasheet has any blank rows between data rows then the Chart will only be produced up to the first blank row it finds whilst prodanalysing the data.

Hope this helps.

Tony

dccjr · #3 04-15-2013, 12:32 PM

I am wanting it to chart the entire data set in one chart. There are not any blank spaces. Any ideas on how to modify it?

OTPM · #4 04-16-2013, 03:03 AM

Hi
If the code you have pasted is exactly what is in your Module then there are a number of spacing errors. I have corrected them in this codeset below. Cut and paste this codeset into your module to replace the curret and see if that resolves your issue:

Function CreateBarCharts() AsBoolean
Dim myChtObj AsChartObject
Dim rngChtData AsRange
Dim rngChtXVal AsRange
Dim iColumn AsLong

Dim sheetName AsString
sheetName = "DataSource"
Dim WSD AsWorksheet
Set WSD = Worksheets(sheetName)

Dim chartSheet AsString
chartSheet = "ChartOutput"
Dim CSD As Worksheet
Set CSD = Worksheets(chartSheet)

' get the current charts so proper overwriting can happen
Dim chtObjs As ChartObjects
Set chtObjs = CSD.ChartObjects

' Turn off autofilter mode
WSD.AutoFilterMode = False

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

Dim i As Integer

' for each row in the sheet
For i = 2 To finalRow

Dim chartName As String
chartName = WSD.Cells(i, 5).Value

' Delete chart if it already exists, we are making a new one
Dim chtObj As ChartObject
For Each chtObj InchtObjs
If chtObj.Name = chartName Then
chtObj.Delete
EndIf
Next

' define chart data range for the row (record)
Dim dataString As String
dataString = "C"& i & "

"& i
Set rngChtData = WSD.Range(dataString)

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

' add the chart
Charts.Add
With ActiveChart

' 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"
End With

.Location Where:=xlLocationAsObject, Name:=chartSheet
End With
With ActiveChart
.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
End With

.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
End With

.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
End With
End With

' Set the height and width
With CSD.ChartObjects(chartName)
.Width = 225
.Height = 175
End With
Next i
End Function

There may still be some errors in the code. If so then post it on the Programming section of the Excel forum and I am sure someone will respond.

Good luck.

Tony

Thread Tools
Show Printable Version Email this Page
Display Modes
Linear Mode Switch to Hybrid Mode Switch to Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Autofill Automation	Parkiee1981	Excel	4	03-15-2013 01:24 PM
ckBox automation	coconutt	Word VBA	6	09-11-2012 04:22 PM
Converting manual chart to bar chart?	aligahk06	Excel	0	07-03-2010 12:23 PM
Urgent help regarding automation.	aligahk06	Excel	1	01-14-2010 01:55 PM
COM Automation Errors	ivanm	Word	0	03-23-2009 07:02 PM