Consulting

Results 1 to 8 of 8

Thread: Help: Dynamic Timeline Chart

  1. #1

    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 )
    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]

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

  3. #3
    VBAX Master
    Joined
    Jun 2007
    Location
    East Sussex
    Posts
    1,110
    Location
    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.
    Regards,
    Rory

    Microsoft MVP - Excel

  4. #4
    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

  5. #5
    Finally finished,

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

    Thanks all for support

  6. #6
    VBAX Master
    Joined
    Jun 2007
    Location
    East Sussex
    Posts
    1,110
    Location
    I think this is a little faster. Are the data labels supposed to all be the same for a series?
    Regards,
    Rory

    Microsoft MVP - Excel

  7. #7
    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

  8. #8
    VBAX Master
    Joined
    Jun 2007
    Location
    East Sussex
    Posts
    1,110
    Location
    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.
    Regards,
    Rory

    Microsoft MVP - Excel

Posting Permissions

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