ExcelBanter - Realtime chart example

Hi,

The following code builds a chart displaying realtime data.

To use, copy all the code into a worksheet object in the VBA editor in
a new workbook with calculation set to automatic. Then run the
'createSheet' macro from the VBA editor. You should then get a chart
and two buttons on the sheet.

The important functions are Worksheet_Calculate and createChart.
The runChart and stopChart functions are just for demonstration
purposes. In a real application you might put a realtime function in
the range 'DynamicChartVariable', e.g. =blp|M!'USDEUR Curncy,[ASK]'

-----------------------------------------------------------------
Option Explicit

' Maximum number of data points to display
Private Const maxIndex As Integer = 500

' This controls number of timestamp labels shown
' (which prevents them overlapping).
' Set it to:
' (time in seconds taken to generate 'maxIndex' data points)
' divided by (number of timestamp labels required)
Private Const timestampIntervalSeconds As Integer = 200

Private dtStartDate As Variant
Private dtLastTimeStamp As Date
Private dblLastValue As Variant
Private intLastIndex As Integer

' This is just for our dummy realtime data mechanism
Private bRunning As Boolean

Private Sub Worksheet_Calculate()
Dim calcStart As Date, dblValue As Variant

calcStart = Now
dblValue = Me.Range("DynamicChartVariable").Value
If IsError(dblValue) Then
Exit Sub
End If

If IsEmpty(dtStartDate) Then
Me.Range("DynamicChartData").Clear
dtStartDate = DateSerial(Year(calcStart), _
Month(calcStart), Day(calcStart))
dtLastTimeStamp = _
DateAdd("s", -(timestampIntervalSeconds + 1), calcStart)
intLastIndex = 1
End If

If dblLastValue < dblValue Then
With Me.Range("DynamicChartData")
.Cells(intLastIndex, 1) = _
(calcStart - dtStartDate) * 100000
If DateDiff("s", dtLastTimeStamp, calcStart) _
timestampIntervalSeconds Then
.Cells(intLastIndex, 2) = calcStart
dtLastTimeStamp = calcStart
Else
.Cells(intLastIndex, 2) = ""
End If
.Cells(intLastIndex, 3) = dblValue
End With

dblLastValue = dblValue

If intLastIndex = maxIndex Then
intLastIndex = 1
Else
intLastIndex = intLastIndex + 1
End If
End If
End Sub

Private Sub createSheet()
ActiveWorkbook.Names.Add _
Name:=Me.Name & "!DynamicChartVariable", _
RefersToR1C1:="=" & Me.Name & "!R2C3"
ActiveWorkbook.Names.Add _
Name:=Me.Name & "!DynamicChartData", _
RefersToR1C1:="=" & Me.Name & "!R1C11:R" & maxIndex & "C13"

Me.Cells(1, 11) = (Now - Application.Floor(Now, 1)) * 100000
Me.Cells(1, 12) = Now
Me.Cells(1, 13) = 0.6

With Me.Buttons.Add(66.75, 40.5, 123, 39.75)
.OnAction = Me.Name & ".runChart"
.Characters.Text = "Run"
End With
With Me.Buttons.Add(64.5, 96.75, 126, 45.75)
.OnAction = Me.Name & ".stopChart"
.Characters.Text = "Stop"
End With

createChart
End Sub

Public Sub runChart()
Dim newHour As Integer, newMinute As Integer, _
newSecond As Integer, upperbound As Integer, _
lowerbound As Integer, waitTime As Date
upperbound = 8
lowerbound = 1
bRunning = True
Do While bRunning
Me.Range("DynamicChartVariable").Formula = "=0+" & Rnd

newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + _
Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime

DoEvents
Loop
End Sub

Public Sub stopChart()
bRunning = False
End Sub

Private Sub createChart()
With Me.ChartObjects.Add(50, 150, 500, 300)
.Placement = xlFreeFloating
With .Chart
With .SeriesCollection.NewSeries
.XValues = Me.Range("DynamicChartData").Resize(, 1)
.Values = _
Me.Range("DynamicChartData").Offset(, 2).Resize(, 1)
.ChartType = xlLine
End With

With .SeriesCollection.NewSeries
.XValues = Me.Range("DynamicChartData").Resize(, 1)
.Values = _
Me.Range("DynamicChartData").Offset(, 1).Resize(, 1)
.ChartType = xlColumnClustered
.Border.LineStyle = xlLineStyleNone
.Interior.ColorIndex = xlColorIndexNone
.ApplyDataLabels xlShowValue
With .DataLabels
.NumberFormat = "hh:mm:ss"
.Position = xlLabelPositionInsideBase
.Orientation = xlUpward
.Font.Bold = True
End With
.AxisGroup = xlSecondary
End With

With .Axes(xlCategory)
.Crosses = xlAutomatic
.CategoryType = xlTimeScale
.MajorTickMark = xlNone
.MinorTickMark = xlNone
.TickLabelPosition = xlNone
.AxisBetweenCategories = False
End With
With .Axes(xlValue, xlSecondary)
.MajorTickMark = xlNone
.MinorTickMark = xlNone
.TickLabelPosition = xlNone
End With

.PlotArea.Interior.ColorIndex = xlNone
.HasLegend = False
End With
End With
End Sub