Help: Dynamic Timeline Chart

HI all,

I'm doing on creating an timeline chart, then any input will be draw automatically...

But I'm facing to follow and need you all help:
1.First it works when there is only one series, but after add another series, it crash. And the error is :"Runtime error:1004 Unable to Set the XValues Properties of The Series Class"

2.And I also need you all help in change control component properties. Here I'm trying to change the scroll bar max- min value in VBA. But realy dont know how the code look like. (I'm newbie in VBA :help)
3. Is there anyway to catch event from control component change in real time. I mean when I drag the scroll bar, the chart based on it will change continuously and in real time.


Here is the code and the file, please help :(:

[VBA]Option Explicit
Private Sub DrawButton_Click()

Dim FirstDay As Double
Dim LastDay As Double
Dim DateValue As Double
Dim MaxEvent As Integer
Dim LastRow As Integer
Dim icount As Integer
Dim linecount1 As Integer
Dim linecount2 As Integer
Dim height As Integer

'On Error Resume Next

Const DataLabelLine As Integer = 25

'Clear Content
Range("AA26:AK60000").ClearContents

'Count Events
MaxEvent = Application.CountA(Range("B:B")) - Application.CountA(Range("B1:B25"))
'Last Row
LastRow = MaxEvent + DataLabelLine
' Get display range
FirstDay = Range("AB25")
LastDay = Range("AC25")
'Initailize line count
linecount1 = 0
linecount2 = 0
'Filter Data in chosen range
For icount = DataLabelLine + 1 To LastRow
DateValue = Cells(icount, 5).Value
If (DateValue > FirstDay) And (DateValue < LastDay) Then
linecount1 = linecount1 + 1
Cells(linecount1 + DataLabelLine, 28) = Cells(icount, 5)
Cells(linecount1 + DataLabelLine, 29) = Cells(icount, 6)
End If
Next

For icount = DataLabelLine + 1 To LastRow
DateValue = Cells(icount, 7).Value
If (DateValue > FirstDay) And (DateValue < LastDay) Then
linecount2 = linecount2 + 1
Cells(linecount2 + DataLabelLine, 36) = Cells(icount, 7)
Cells(linecount2 + DataLabelLine, 37) = Cells(icount, 8)
End If
Next
'Formart range back to number
Columns("AA:AC").Select
With Selection
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("AI:AL").Select
With Selection
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
'Filter data for calculation
Range("AA26:AC" & linecount1 + DataLabelLine).Sort Key1:=Range("AB26"), Order1:=xlAscending, Header:=xlGuess _
, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

Range("AI26:AK" & linecount2 + DataLabelLine).Sort Key1:=Range("AJ26"), Order1:=xlAscending, Header:=xlGuess _
, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
'Count height for Series 1
height = 50
For icount = 1 To linecount1
If height > 4 Then
Cells(icount + DataLabelLine, 27) = height
height = height - 5
Else
height = 50
Cells(icount + DataLabelLine, 27) = height
height = height - 5
End If
Next
'Count height for Series 2
height = 50
For icount = 1 To linecount2
If height > 4 Then
Cells(icount + DataLabelLine, 35) = -height
height = height - 5
Else
height = 50
Cells(icount + DataLabelLine, 35) = -height
height = height - 5
End If
Next

'Drawing Chart
ActiveSheet.ChartObjects("Chart 1").Activate
If Range("AD25").Value = "True" Then
ActiveChart.SeriesCollection(1).XValues = "=EventList!R26C28:R" & (linecount1 + DataLabelLine) & "C28"
ActiveChart.SeriesCollection(1).Values = "=EventList!R26C27:R" & (linecount1 + DataLabelLine) & "C27"
Else
ActiveChart.SeriesCollection(1).XValues = "=EventList!R1C28:R6C28"
ActiveChart.SeriesCollection(1).Values = "=EventList!R1C27:R6C27"
End If

If Range("AL25").Value = "True" Then
ActiveChart.SeriesCollection(2).XValues = "=EventList!R26C36:R" & (linecount2 + DataLabelLine) & "C36"
ActiveChart.SeriesCollection(2).Values = "=EventList!R26C35:R" & (linecount2 + DataLabelLine) & "C35"
Else
ActiveChart.SeriesCollection(2).XValues = "=EventList!R1C36:R6C36"
ActiveChart.SeriesCollection(2).Values = "=EventList!R1C35:R6C35"
End If

'Set Chart range
With ActiveChart.Axes(xlCategory)
.MinimumScale = FirstDay - 10
.MaximumScale = LastDay + 10
.MinorUnit = 30
.MajorUnit = 30
.Crosses = xlAutomatic
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
End With
End Sub
[/VBA]

Forget to say, error come from following command:
[VBA]ActiveChart.SeriesCollection(1).XValues = "=EventList!R1C28:R6C28"[/VBA]

The problem with your XValues code is that you are clearing the data for the existing series at the top of your code. Once you do that, the data for the series is invalid and you can't then change it using the XValues (or Values) property of the Series object. If you only clear the unwanted cells after you have copied the data you want across, then your code will work. Alternatively, you can use the SetSourceData method of the Chart object.
To set the Max property of your scrollbar, you can use code like this:
[VBA]activesheet.shapes("MaxScrollBar").oleformat.object.object.max[/VBA]
The Scrollbar controls have a change event that you can use to react to changes in their values.

I have re-code the file, it's okie.

But when use scrollbar click event to active the draw sub, it can just run 1 time, then I can not select, click anything in the sheet area.

please do help again.
Many thanks

Finally finished,

Please kindly help in feedback on your way how to make it faster.

Thanks all for support

I think this is a little faster. Are the data labels supposed to all be the same for a series?

Many thanks ROry, really faster a lot.

Can you please explain more? I did not get your point yet.

By the way, i have make some change, pls check and feedback

That seems fine and you have fixed the issue with the datalabels anyway. You can remove the GetFilterRange function from the code as I didn't use it in the end.