Consulting

Results 1 to 4 of 4

Thread: Problem with chart

  1. #1

    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?


    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
    Last edited by Aussiebear; 04-08-2016 at 06:12 PM. Reason: Added code tags

  2. #2
    Moderator VBAX Guru Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    4,997
    Location
    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?
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  3. #3
    VBAX Expert Dave's Avatar
    Joined
    Mar 2005
    Posts
    832
    Location
    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

  4. #4
    Moderator VBAX Guru Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    4,997
    Location
    Thank you Dave
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

Posting Permissions

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