CODEWITHSUNDEEP
vbaexcelcharts
MJA
MJA

Reputation: 358

VBA: Update chart to last three periods of data

I have several charts in a workbook (one per worksheet) that report the last three weeks of data. The source data is non-contiguous columns in a ListObject table. Every week when the tables are updated with a new week of data (additional row) I want the charts to update.

This is similar to this post but I'm updating the series range instead of adding another series.

Here's some sample data:

A       B       C       D       E       F
Start   End     Green   Yellow  Red     Total
------- ------- ------- ------- ------- -------
1/1/16  1/7/16  10      10      10      30
1/8/16  1/14/16 12      12      12      36
1/15/16 1/21/16 12      20      18      50
1/22/16 1/28/16 30      10      50      45

The chart would first look like this: Chart prior to VBA modification.

Afterwards it would like like this: (disregard color difference) Chart after VBA modification

Any suggestions on the easiest way to do this?

The Series formulas end up looking like this:

=SERIES(Project!$A$2,Project!$C$1:$E$1,Project!$C$2:$E$2,1)
=SERIES(Project!$A$3,Project!$C$1:$E$1,Project!$C$3:$E$3,2)
=SERIES(Project!$A$4,Project!$C$1:$E$1,Project!$C$4:$E$4,3)

I'm thinking of iterating through each Series in SeriesCollection, parsing out the different comma separated values, and updating the range. Something like this:

set clnSeries = activechart.seriescollection 
dim strSeriesTemp as string 'Placeholder for previous series formula
For i = clnSeries.count to 1 step -1
  if strSeriesTemp = "" then
    strSeriesTemp = clnSeries(i).formula
    arrSeries = split(clnSeries(i).formula, ",")
    for i = lbound(arrSeries) to ubound(arrSeries)
      select case i
        'Move legend label one row down
        case 1: strFormula = arrSeries(i).offset(1,0).address
        'Leave series labels the same
        case 2: strFormula = strFormula & arrSeries(i)
        'Move series values one row down
        case 3: strFormula = strFormula & arrSeries(i).offset(1,0).address
        'Set series index
        case 4: strFormula = strFormula & i
      end select
      strFormula = "=SERIES(" & strFormula & ")"
  else
    clnSeries(i).formula = strFormula
  end if
next i

Upvotes: 2

Views: 1115

Answers (1)

Alexis Olson
Alexis Olson

Reputation: 40244

I think the best way to approach this problem is with dynamic named ranges.

Create the following three named ranges in the Name Manager under the Formulas tab:

Ultimate=OFFSET(Sheet1!$A$1,MATCH(MAX(Sheet1!$B:$B),Sheet1!$B:$B,0)-1,2,1,3)
Penultimate=OFFSET(Sheet1!$A$1,MATCH(MAX(Sheet1!$B:$B),Sheet1!$B:$B,0)-2,2,1,3)
Antepenultimate=OFFSET(Sheet1!$A$1,MATCH(MAX(Sheet1!$B:$B),Sheet1!$B:$B,0)-3,2,1,3)

Define Dynamic Ranges

Then right click on the chart, Select Data, Edit the Series values to be:

=Sheet1!Antepenultimate
=Sheet1!Penultimate
=Sheet1!Ultimate

Then every time you add a new row to your columns, these three ranges will automatically update to be the last three rows assuming the inputs are in chronological order. (Note that Sheet1 will update to your workbook name if you go back to look at it since it's a workbook level named range.)

Explanation: The OFFSET formula references cell A1, then looks down column B until it finds the latest date and shifts down by the latest date's row number, backs up the necessary number of rows, shifts to the right two columns, and finally selects a 1x3 range.

Enter Series Values

Note: In order for your series names to update properly as well, you'll need to make named ranges for them as well.

Hint:

UltimateName=OFFSET(Sheet1!$A$1,MATCH(MAX(Sheet1!$B:$B),Sheet1!$B:$B,0)-1,0)

Upvotes: 2

Related Questions