Problem with chart

[Cinema]

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?

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

[Aussiebear]

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?

[Dave]

Looks OK and compiles but this is untested "tidy up" code. Dave

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

[Aussiebear]

Thank you Dave