VBA to plot several line chart series on a common date X axis

sts023

Board Regular
Joined
Sep 1, 2008
Messages
106
Hi guys....

I have a Workbook (Excel 2010) with several Worksheets - each Worksheet represents a business loan, and each loan has a different start and predicted end date.
On each worksheet I have a column with the Next Payment Date, and another column with the Balance after the payment has been made.

I can fairly easily plot each loan's balance over time using a separate chart for each loan, but what i'd like to do is plot the details of each loan on a single chart, ideally as lines, but having the X axis represent the period from the start of the earliest loan to the predicted final end date.

I have looked at VBA to generate several series on one graph, but I don't know how to set the X axis values to run from the start of the earliest loan to the end of the latest loan.
On a summary Worksheet I have the earliest start date in one cell, and the latest end date in another cell.
Does anyone know how i can effectively say in VBA "set the start of the X axis to 'Early Date', and the end of the X axis to 'Final Date', then plot n series on that chart"?
I know this means that no series will run the full length of the chart, and some will start and end within the chart. If the Client doesn't like how that looks I may need to use a stacked bar chart to show the Company's indebtedness over time, but I suspect I'll have the same problem with the stacked bar chart.

Can anyone suggest any further reading on how to achieve my aim - I've had a good look around the excellent Jon Peltier site, but I can't find anything which seems to help (although with my level of charting experience [feeble] I may have seen examples of similar functionality without recognising them!).

Any help would be gratefully accepted....

Steve
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
Hello Steve
See if this example is useful:

Code:
Option Explicit
Option Base 1


' this code goes at a regular module


Sub Sts_023()
Dim chob As ChartObject, cs As Series, ads, i%


ads = Array("='Sheet1'!$e$50:$e$57", "='Sheet1'!$f$50:$f$57", "='Sheet1'!$g$50:$g$57")
'                 x values     /        y values - series 1   /    y values - series 2


' new chart
Set chob = Sheets("Sheet1").ChartObjects.Add(Left:=Cells(1, 2).Left, Width:=Range("b1:L1").Width, _
Top:=Cells(3, 2).Top, Height:=Range("a2:a22").Height)


For i = 2 To 3
    With chob.Chart
        Set cs = .SeriesCollection.NewSeries
        With cs
            .Values = ads(i)                ' y values
            .XValues = ads(1)
            .ChartType = xlLineMarkers
        End With
    End With
Next


With chob.Chart.Axes(xlCategory)            ' x axe
    .MinimumScale = Sheets("Source").Range("a60").Value
    .MaximumScale = Sheets("Source").Range("b60").Value
End With
End Sub
 
Upvote 0
Useful? USEFULL??? I T S B R I L L I A N T ! ! !

Exactly what I need!
I confess I'd never have worked out how to do it without the supplied example.
Looking at it, it's such an elegant solution.
Thanks, Worf!

Steve
 
Upvote 0
Oops!
There's obviously some flaw in my understanding, 'cos when I try to implement Worf's solution, I get problems. The code below (I can't attach an example, for some reason it's denied) shows the problem. I'm trying to use ranges with different start and end dates, but unless the first range has the earliest and latest dates, subsequent series only appear to chart the number of entries in the first series.
Unfortunately, none of the "real life" series I'm trying to chart have the required attribute of having the first and last dates.
If you execute the SetGraphs VBA on the attached Workbook, you'll see the results.
I suppose I could try to engineer a specimin date range with junk values as series 1, then eventually discard it, but this seems awfully devious (and probably a processing overhead) - There must be a better way.
Also, note that in the VBA there is an early "Exit Sub", 'cos when I try to set the minimum and maximum dates, all that happens is that the X axis is expanded to accomodate the new date range, but the plotted data remains as above.
I've tried moving the "axis resize" code to just after the chart creation (see commented out code), but I get the error message "Method MimimumScale of object 'Axis' failed".

Can anyone help?

Code:
Option Explicit
Option Base 1
Sub SetGraphs()
Dim intPtr                              As Integer
Dim objChart                            As ChartObject
Dim serChartSeries                      As Series
Dim varDates                            As Variant
Dim varValues                           As Variant
'*
'** Delete any existing Charts.
'*
  Sheets("Graphs").Select
  If ActiveSheet.ChartObjects.Count > 0 Then
    ActiveSheet.ChartObjects.Delete
  End If
  varDates = Array("='Graphs'!$B$27:$B$36", _
                   "='Graphs'!$E$27:$E$32", _
                   "='Graphs'!$H$27:$H$39")
  varValues = Array("='Graphs'!$C$27:$C$36", _
                    "='Graphs'!$F$27:$F$32", _
                    "='Graphs'!$I$27:$I$39")
'*
'** Create new chart.
'*
  Set objChart = Sheets("Graphs").ChartObjects.Add( _
                 Left:=Cells(1, 2).Left, _
                 Width:=Range("B1:L1").Width, _
                 Top:=Cells(3, 2).Top, _
                 Height:=Range("A2:A22").Height)
'  With objChart.Chart.Axes(xlCategory)
'    .MinimumScale = Sheets("Graphs").Range("C41").Value
'    .MaximumScale = Sheets("Graphs").Range("C42").Value
'  End With
'*
'** Load 3 Series to new chart.
'*
  For intPtr = 1 To 3
    With objChart.Chart
      Set serChartSeries = .SeriesCollection.NewSeries
      With serChartSeries
        .Values = varValues(intPtr)
        .XValues = varDates(intPtr)
        .ChartType = xlColumnStacked
      End With
'     .Axes(xlCategory).MinimumScale = Sheets("Graphs").Range("C41").Value
'     .Axes(xlCategory).MaximumScale = Sheets("Graphs").Range("C42").Value
      Select Case intPtr
        Case 1
          .SeriesCollection(intPtr).Interior.Color = RGB(255, 150, 190)
        Case 2
          .SeriesCollection(intPtr).Interior.Color = RGB(100, 200, 50)
        Case 3
          .SeriesCollection(intPtr).Interior.Color = RGB(250, 75, 0)
      End Select
      .SeriesCollection(intPtr).ApplyDataLabels
    End With
  Next intPtr
  Exit Sub
  With objChart.Chart.Axes(xlCategory)
    .MinimumScale = Sheets("Graphs").Range("C41").Value
    .MaximumScale = Sheets("Graphs").Range("C42").Value
  End With
End Sub
The data is as follows in cols A26:I42 (Headings in A25:I25
[TABLE="width: 581"]
<tbody aria-dolphinuid="972:17:7c34">[TR]
[TD]A
[/TD]
[TD]B
[/TD]
[TD]C
[/TD]
[TD]D
[/TD]
[TD]E
[/TD]
[TD]F
[/TD]
[TD]G
[/TD]
[TD]H
[/TD]
[TD]I
[/TD]
[/TR]
[TR]
[TD="align: right"]27/02/2013
[/TD]
[TD="colspan: 2"]Series 1
[/TD]
[TD][/TD]
[TD="colspan: 2"]Series 2
[/TD]
[TD][/TD]
[TD="colspan: 2"]Series 3
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD="align: right"]11/2012
[/TD]
[TD="align: right"]10
[/TD]
[TD][/TD]
[TD="align: right"]05/2013
[/TD]
[TD="align: right"]20
[/TD]
[TD][/TD]
[TD="align: right"]08/2012
[/TD]
[TD="align: right"]30
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD="align: right"]12/2012
[/TD]
[TD="align: right"]11
[/TD]
[TD][/TD]
[TD="align: right"]06/2013
[/TD]
[TD="align: right"]22
[/TD]
[TD][/TD]
[TD="align: right"]09/2012
[/TD]
[TD="align: right"]31
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD="align: right"]01/2013
[/TD]
[TD="align: right"]12
[/TD]
[TD][/TD]
[TD="align: right"]07/2013
[/TD]
[TD="align: right"]24
[/TD]
[TD][/TD]
[TD="align: right"]10/2012
[/TD]
[TD="align: right"]32
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD="align: right"]02/2013
[/TD]
[TD="align: right"]13
[/TD]
[TD][/TD]
[TD="align: right"]08/2013
[/TD]
[TD="align: right"]26
[/TD]
[TD][/TD]
[TD="align: right"]11/2012
[/TD]
[TD="align: right"]33
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD="align: right"]03/2013
[/TD]
[TD="align: right"]14
[/TD]
[TD][/TD]
[TD="align: right"]09/2013
[/TD]
[TD="align: right"]28
[/TD]
[TD][/TD]
[TD="align: right"]12/2012
[/TD]
[TD="align: right"]34
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD="align: right"]04/2013
[/TD]
[TD="align: right"]15
[/TD]
[TD][/TD]
[TD="align: right"]10/2013
[/TD]
[TD="align: right"]30
[/TD]
[TD][/TD]
[TD="align: right"]01/2013
[/TD]
[TD="align: right"]35
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]11/2013
[/TD]
[TD="align: right"]32
[/TD]
[TD][/TD]
[TD="align: right"]02/2013
[/TD]
[TD="align: right"]36
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]12/2013
[/TD]
[TD="align: right"]34
[/TD]
[TD][/TD]
[TD="align: right"]03/2013
[/TD]
[TD="align: right"]37
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]01/2014
[/TD]
[TD="align: right"]36
[/TD]
[TD][/TD]
[TD="align: right"]04/2013
[/TD]
[TD="align: right"]38
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]05/2013
[/TD]
[TD="align: right"]39
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]06/2013
[/TD]
[TD="align: right"]40
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]07/2013
[/TD]
[TD="align: right"]41
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]08/2013
[/TD]
[TD="align: right"]42
[/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
Hi
One possible solution is to rearrange your source data in a way that x-axis data is represented by only one column:

Code:
Option Explicit: Option Base 1


Sub Normalize()
Dim vDates, sdate#, edate#, i%, a#, b#, vMonth$(1 To 2), ul As Range, _
vYear$(1 To 2), c As Range, sr, nr As Range, chob As ChartObject, cs As Series


Set ul = Range("k27")
vDates = Array("b27:b36", "e27:e35", "h27:h39", "b:b", "e:e", "h:h", "k:k")
sdate = 1E+300
edate = 0
For i = 1 To 3         ' find start date
    a = Application.WorksheetFunction.Min(Range(vDates(i)))
    If a < sdate Then sdate = a
Next
For i = 1 To 3         ' find end date
    b = Application.WorksheetFunction.Max(Range(vDates(i)))
    If b > edate Then edate = b
Next
vMonth(1) = CStr(Month(sdate))
vYear(1) = CStr(Year(sdate))
vMonth(2) = CStr(Month(edate))
vYear(2) = CStr(Year(edate))
For i = 4 To 7
    Range(vDates(i)).NumberFormat = "0.00"
Next
i = 1
ul.FormulaR1C1 = "=date(" & vYear(1) & "," & vMonth(1) & ",1)"


Do                                  ' generate date list
    If vMonth(1) = 12 Then
        vMonth(1) = 1
        vYear(1) = vYear(1) + 1
    Else
        vMonth(1) = vMonth(1) + 1
    End If
    ul.Offset(i).FormulaR1C1 = "=date(" & vYear(1) & "," & vMonth(1) & ",1)"
    i = i + 1
Loop Until Month(ul.Offset(i - 1).Value) = vMonth(2) And Year(ul.Offset(i - 1).Value) = vYear(2)


For i = 1 To 3         ' place y data at correct dates
    sr = Split(vDates(i), ":")
    Set c = Range(vDates(7)).Find(Range(sr(0)).Value, LookIn:=xlValues)
    c.Offset(0, i).Resize(Range(vDates(i)).Rows.Count).Value = _
    Range(vDates(i)).Offset(0, 1).Value
Next


Set chob = Sheets("Sheet1").ChartObjects.Add(Left:=Cells(1, 2).Left, Width:=Range("b1:L1").Width, _
Top:=Cells(3, 2).Top, Height:=Range("a2:a22").Height)
Set nr = ul.CurrentRegion
For i = 4 To 7
    Range(vDates(i)).NumberFormat = "[$-416]mmm-yy;@"
Next


For i = 2 To nr.Columns.Count
    With chob.Chart
        Set cs = .SeriesCollection.NewSeries
        With cs
            .Values = "='Sheet1'!" & nr.Columns(i).Address      ' y values
            .XValues = "='Sheet1'!" & nr.Columns(1).Address
            .ChartType = xlLineMarkers
        End With
    End With
Next
End Sub
 
Upvote 0

Forum statistics

Threads
1,223,227
Messages
6,170,848
Members
452,361
Latest member
d3ad3y3

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top