-
Problem with chart
Hello,
I have some datas on the sheet "Graphics" which I want to plot in the SAME Chart. But my code creates a new Chart for the new row by deletting the current Chart. How can I plot all my datas in the same Chart?
Code:
Function CreateLineCharts() As Boolean
Dim myChtObj As ChartObject
Dim rngChtData As Range
Dim rngChtXVal As Range
Dim iColumn As Long
Dim sheetName As String
sheetName = "DataSource"
Dim WSD As Worksheet
Set WSD = Worksheets("Graphics")
Dim chartSheet As String
chartSheet = "ChartOutput"
Dim CSD As Worksheet
Set CSD = Worksheets("Table3")
'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
Dim i As Integer
finalRow = WSD.Cells(Application.Rows.Count, 2).End(xlUp).row
'add the chart
Charts.Add
With ActiveChart
'to determine how many values to loop over, find the last row in the data set
For i = 1 To finalRow
Dim chartName As String
chartName = WSD.Cells(i, 1).Value
'Delete Chart if it already exists, make a new one
Dim chtObj As ChartObject
For Each chtObj In chtObjs
If chtObj.Name = chartName Then
chtObj.Delete
End If
Next
'define chart data range for the row (record)
Dim dataString As String
dataString = "B" & i & ":P" & i
Set rngChtData = WSD.Range(dataString)
'define the x axis values
Set rngChtXVal = WSD.Range("$B$1:$P$1")
'make a Line chart
.ChartType = xlLineStacked
'remove extra series
Do Until .SeriesCollection.Count = 0
.SeriesCollection(1).Delete
Loop
'add series from selected range, column by column
With .SeriesCollection.NewSeries
.Values = rngChtData
.XValues = rngChtXVal
.Name = "XX"
End With
Next i
End With
End Function
-
I know this is an old thread but I found it during a "Housekeeping" moment, it was stuck away in "Announcements". Could someone have a crack at it so we can tidy up the forum please?
-
Looks OK and compiles but this is untested "tidy up" code. Dave
Code:
Option Explicit
Function CreateLineCharts() As Boolean
Dim rngChtData As Range, rngChtXVal As Range, WSD As Worksheet
Dim chtObjs As ChartObjects, finalRow As Long, i As Integer
Dim chtObj As ChartObject, chartName As String
Dim dataString As String, ChtCnt As Integer
Set WSD = Worksheets("Graphics")
'turn off autofilter mode
WSD.AutoFilterMode = False
'remove previous chart
chartName = CStr(WSD.Cells(i, 1).Value)
Set chtObjs = WSD.ChartObjects
For Each chtObj In chtObjs
If chtObj.Name = chartName Then
chtObj.Delete
End If
Next
'add new chart
ChtCnt = WSD.ChartObjects.Count + 1
Charts.Add.Location Where:=xlLocationAsObject, Name:=WSD
WSD.ChartObjects(ChtCnt).Chart.ChartType = xlLineStacked
WSD.ChartObjects(ChtCnt).Name = chartName
WSD.ChartObjects(chartName).Placement = xlMoveAndSize
'define the x axis values
Set rngChtXVal = WSD.Range("$B$1:$P$1")
With WSD.ChartObjects(chartName).Chart
'to determine how many values to loop over, find the last row in the data set
finalRow = WSD.Cells(WSD.Rows.Count, 2).End(xlUp).Row
For i = 1 To finalRow
'define chart data range for the row (record)
dataString = "B" & i & ":P" & i
Set rngChtData = WSD.Range(dataString)
'add series from selected range, column by column
With .SeriesCollection.NewSeries
.Values = rngChtData
.XValues = rngChtXVal
.Name = "XX" & i
End With
Next i
WSD.ChartObjects(chartName).Chart.SeriesCollection(1).Delete
End With
If Err.Number = 0 Then
CreateLineCharts = True
Else
MsgBox "Error"
CreateLineCharts = False
End If
End Function
-