Series Problem - Short on time so ANY suggestions welcome!

[aMember]

I've had this working but never perfectly. On occasion for some reason I have not been able to determine, it fails (I mean the chart series gives me a 1004 error)

I have a"table" (called LI) and an embedded chart (PH) on Sheets("QC&quot.
Sheets("Data&quot contains a row of dates with data in each column containing a date.
The object of the game is for table LI and chart PH to look at only 6 months of data at a time. All the functions below are what make that happen. ShiftLeft and ShiftRight look back in history or into the future. SkipMonths is a routine that allows the user to pick a month/year from a drop down box (populated on WB_Open and any time the row of dates is changed) and lets them jump immediately to that month (instead of, for example, having to press ShiftLeft 10 times to look at data 10 months ago)

FYI, the lookup routines were created because it seems the workbookfunction.match
is not reliable. My data during development has not changed in months yet sometimes
match fails on data I know it has succeeded with prior.

The problem code is noted below with '*****
Any help is greatly appreciated as I am running out of time with this and I am out of ideas.
Thanks in advance,
Andrea

Option Explicit
Option Compare Text
Public PHChartObj As ChartObject
Public PHChart As Chart

'-------------------------------
Public Sub MoveSeries(NumToMove As Integer)
Dim CPIRow
Dim DateRow
Dim theDates As Range
Dim DataSheet As Worksheet
Dim OldestMonth As Range
Dim NewestMonth As Range
Dim QuadChartWindow As Range
Dim DateWindow As Variant
Dim DataWindow As Variant

CPIRow = Range("CPIData&quot.Row
DateRow = Range("Date&quot.Row
Set theDates = Range("Date&quot
Set DataSheet = Sheets("Data&quot
Set QuadChartWindow = Sheets("QC&quot.Range("TheWindow&quot

'Find the Oldest date in theDates
Set OldestMonth = FindOldestDate(QuadChartWindow)
Set OldestMonth = LookupDate(OldestMonth.Value, DataSheet, DataSheet.Range("Date&quot)
If OldestMonth Is Nothing Then
MsgBox "Error updating Program Health chart"
GoTo Cleanup
End If

'Find the newest date in theDates
Set NewestMonth = FindNewestDate(QuadChartWindow, DataSheet, OldestMonth.Column)

If IsEmpty(NewestMonth.Value) Then
'at the end of the visible list.
Exit Sub
End If

Set PHChartObj = ActiveSheet.ChartObjects(1)
Set PHChart = PHChartObj.Chart

'Create Date and DataWindows that points to 6 columns of dates on the Data sheet
Set DateWindow = DataSheet.Range(OldestMonth.Address, NewestMonth.Address)
Set DataWindow = DateWindow.Offset(Sheets("Data&quot.Range("CPIData&quot.Row - 1)

'*************************************
'* Problems start in here. I can activate the object
'* and set the series CPI to ChartSeries.
'* I cannot, however, do either of the following:
'* ChartSeries.Values = DataWindow
'* SeriesCollection("CPI&quot.Values = DataWindow
'* I get a "Unable to set the Values property of
'* the Series class" error.
'* Data is valid in the range. The range is only
'* 6 columns of data.
'*************************************

'Set range for CPI
PHChartObj.Activate
Dim ChartSeries As Series
Set ChartSeries = ActiveChart.SeriesCollection("CPI&quot
ChartSeries.Values = DataWindow
'SeriesCollection("CPI&quot.Values = DataWindow
'Set Range for SPI
Set DataWindow = DateWindow.Offset(Sheets("Data&quot.Range("SPIData&quot.Row - 1)
PHChartObj.SeriesCollection("SPI&quot.Values = DataWindow
'Set Range for BAC/EAC4
Set DataWindow = DateWindow.Offset(Sheets("Data&quot.Range("BACEAC4&quot.Row - 1)
PHChartObj.SeriesCollection("BAC/EAC4&quot.Values = DataWindow
'Set Category labels
PHChartObj.SeriesCollection("BAC/EAC4&quot.XValues = DateWindow

Sheets("QC&quot.Range("h10&quot.Select

Cleanup:
Set DataSheet = Nothing
Set QuadChartWindow = Nothing
Set OldestMonth = Nothing
Set NewestMonth = Nothing

End Sub


'-------------------------------
Sub SkipMonths(ByVal MonthsToSkip As Integer)
Dim ListIndex, ListCount

Application.ScreenUpdating = False
'QC sheet needs to be active to use this function
If ActiveSheet.Name <> &quot;QC&quot; Then
MsgBox &quot;The QC sheet must be active to use this function&quot;
Exit Sub
End If
'Check to see if months on Data sheet have been extended. They have if count in list box &quot;Program Dates&quot; on QC toolbar
'is different than number of dates in Date row on Data sheet.
If WorksheetFunction.CountA(Sheets(&quot;Data&quot.Range(&quot;Date&quot) - 1 <> CommandBars(&quot;QC&quot.Controls(&quot;Program Dates&quot.ListCount Then
Call CreateToolbar
End If

ListIndex = CommandBars(&quot;QC&quot.Controls(&quot;Program Dates&quot.ListIndex

ListCount = CommandBars(&quot;QC&quot.Controls(&quot;Program Dates&quot.ListCount

ActiveWorkbook.Sheets(&quot;QC&quot.Range(&quot;TheOffset&quot.Value = ListCount - ListIndex + 1 '+ MonthsToSkip

MoveSeries MonthsToSkip

Call Refresh

Application.ScreenUpdating = True
End Sub

'-------------------------------
Sub ShiftRight_Click()
If ActiveSheet.Name <> &quot;QC&quot; Then
MsgBox &quot;The QC sheet must be active to use this function&quot;
Exit Sub
End If
If WorksheetFunction.CountA(Sheets(&quot;Data&quot.Range(&quot;Date&quot) - 1 <> CommandBars(&quot;QC&quot.Controls(&quot;Program Dates&quot.ListCount Then
Call CreateToolbar
End If

'On Error Resume Next
If CommandBars(&quot;QC&quot.Controls(&quot;Program Dates&quot.ListIndex < CommandBars(&quot;QC&quot.Controls(&quot;Program Dates&quot.ListCount Then
CommandBars(&quot;QC&quot.Controls(&quot;Program Dates&quot.ListIndex = CommandBars(&quot;QC&quot.Controls(&quot;Program Dates&quot.ListIndex + 1

End If
If Sheets(&quot;QC&quot.Range(&quot;TheOffset&quot > 1 Then
Sheets(&quot;QC&quot.Range(&quot;TheOffset&quot = Sheets(&quot;QC&quot.Range(&quot;TheOffset&quot - 1
End If
'Adjust offsets and pointers for moving months on Leading indicator's table
Call SkipMonths(1)
Call DoTotalSum(&quot;Total1&quot
Call DoTotalSum(&quot;Total3&quot


End Sub

'-------------------------------
Sub Shiftleft_Click()
'Looking at the LI table, the date fields are named cells.
' From Left to Right they are:
' Month6 Month5 Month4 Month3 Month2 Month1
'Month1 and Month2 are &quot;two months future&quot;
'Month3 is the most recent month containing actual data
'Month4, Month5, and Month6 are 3 months of past data.
'This is a sliding window and look at it this way.
'Pretend you put your finger on Month3...the most recent month containing acutal
'data. If you push Month3 one cell to the right, you are pushing the data into
' Month2 and Month2 into Month1. Likewise, you are pulling data into Month6
' and then from Month6 to Month5, and so on.

'On Error Resume Next
If ActiveSheet.Name <> &quot;QC&quot; Then
MsgBox &quot;The QC sheet must be active to use this function&quot;
Exit Sub
End If
If WorksheetFunction.CountA(Sheets(&quot;Data&quot.Range(&quot;Date&quot) - 1 <> CommandBars(&quot;QC&quot.Controls(&quot;Program Dates&quot.ListCount Then
'if the date range on the Data sheet has changed (e.g. if dates have been added to the row), regenerate
' the toolbar
Call CreateToolbar
End If
If CommandBars(&quot;QC&quot.Controls(&quot;Program Dates&quot.ListIndex > 1 Then
CommandBars(&quot;QC&quot.Controls(&quot;Program Dates&quot.ListIndex = _
CommandBars(&quot;QC&quot.Controls(&quot;Program Dates&quot.ListIndex - 1
End If
Dim LastDate As Range
Set LastDate = Sheets(&quot;Data&quot.Range(&quot;IV1&quot.End(xlToLeft)
Dim ActualDates As Range
Set ActualDates = Range(&quot;F1&quot;, LastDate.Address)
If Sheets(&quot;QC&quot.Range(&quot;TheOffset&quot < ActualDates.Count Then
Sheets(&quot;QC&quot.Range(&quot;TheOffset&quot = Sheets(&quot;QC&quot.Range(&quot;TheOffset&quot + 1
End If
Call SkipMonths(-1)
Call DoTotalSum(&quot;Total1&quot
Call DoTotalSum(&quot;Total3&quot

End Sub

'-------------------------------
Private Function FindOldestDate(DateRange As Range) As Range
Dim Mon
Dim NumOldExamined
Dim OldestMonth As Range

Set OldestMonth = Nothing
NumOldExamined = 0
For Each Mon In DateRange
If Not WorksheetFunction.IsError(Mon.Value) Then
Set OldestMonth = Mon
Exit For
End If
NumOldExamined = NumOldExamined + 1
Next
Set FindOldestDate = OldestMonth
NumExamined = NumOldExamined
Set OldestMonth = Nothing

End Function

'-------------------------------
Private Function LookupDate(LookupValue As String, OnSheet As Worksheet, DateRange As Range) As Range
Dim MatchCol As Integer
If NumExamined < 6 Then
'NOT (all 6 dates were looked at and all contained errors (e.g. no data available))

'Do a match lookup on theDates on QC to find the column of the oldest month
'(Match function not reliable. Created home-made match function)
MatchCol = doMatch(LookupValue, DateRange)
'Create a range that points to this oldest month on Data sheet
Set LookupDate = OnSheet.Range(OnSheet.Cells(1, MatchCol).Address)
End If

End Function

'-------------------------------
Private Function doMatch(LookupValue As String, theRange As Range) As Integer
Dim Val
Dim FoundMatchCol As Integer
FoundMatchCol = 0

For Each Val In theRange
If LookupValue = Val Then
FoundMatchCol = Val.Column
Exit For
End If
Next

doMatch = FoundMatchCol
End Function

'-------------------------------
Private Function FindNewestDate(DateRange As Range, OnSheet As Worksheet, OldestMonthCol As Integer) As Range
Dim Mon
Dim NewestMonth As Range
Set NewestMonth = Nothing
For Each Mon In DateRange
If Not WorksheetFunction.IsError(Mon.Value) And Mon.Column >= OldestMonthCol Then
Set NewestMonth = Mon
End If
Next
'Create a range that points to the newest date on the data sheet
Set NewestMonth = OnSheet.Range(OnSheet.Cells(1, OldestMonthCol + (6 - NumExamined - 1)).Address)
Set FindNewestDate = NewestMonth
Set NewestMonth = Nothing

End Function

 

[RobBroekhuis]

The first problem I see is with the DataWindow assignment:

Set DataWindow = DateWindow.Offset(Sheets(&quot;Data&quot.Range(&quot;CPIData&quot.Row - 1)

If you need the entire block of data but not the headers to be selected, you need:

Set DataWindow = range(oldestmonth.offset(1,0),newestmonth.offset(&quot;CPIData&quot.Row - 1,0))

Since this is a contiguous block, you should be able to reassign the whole chart source range using

PHChart.setsourcedata DataWindow

Rob

 

[scottsek]

One problem is that you're using PHChartObj.SeriesCollection instead of PHChart.SeriesCollection. SeriesCollection is a collection of Chart, not ChartObject.

HTH,
Scott

 

[scottsek]

... and I don't see where NumToMove (from the header) is anywhere else in your code, maybe you snipped it when you posted.

Scott

 

[aMember]

Hi All,
First, sorry for the double post (&quot;Submit&quot; said it didn't submit.)

Second, thanks for the help. Unfortunately, timing was off to help me.

I don't know what I was doing wrong but took a step back and implemented it differently. I changed the chart series Values to point to named ranges then changed my MoveSeries routine to do this:

The code to change the series (from MoveSeries) was changed to this:

'Create Date and DataWindows that points to 6 columns of dates on the Data sheet
ChartName = Worksheets(&quot;QC&quot.ChartObjects(1).Name
ActiveSheet.ChartObjects(ChartName).Activate
ActiveChart.ChartArea.Select
Set DateWindow = DataSheet.Range(OldestMonth.Address, NewestMonth.Address)
DateWindow.Name = &quot;DateWindow&quot;
Set DataWindow = DateWindow.Offset(Sheets(&quot;Data&quot.Range(&quot;CPIData&quot.Row - 1, 0)
DataWindow.Name = &quot;CPI&quot;
Set DataWindow = DateWindow.Offset(Sheets(&quot;Data&quot.Range(&quot;SPIData&quot.Row - 1, 0)
DataWindow.Name = &quot;SPI&quot;
Set DataWindow = DateWindow.Offset(Sheets(&quot;Data&quot.Range(&quot;BACEAC4&quot.Row - 1)
DataWindow.Name = &quot;BACEAC4&quot;
Sheets(&quot;QC&quot.Range(&quot;h10&quot.Select


Works perfectly.
Thanks once again!
Andrea