In order to optimize real time data loading into excel you want to utilize VB setlinkondata function. Using this feature you can have real time data update faster than the 1 second timer you are using.
Excel out of the box will not update real time data links faster than 100ms. Setlinkondata can be set to trigger a macro to run whenever new data is present.
I use this function to update and transfer the entire block into the worksheet. As a result my real time data update excel at 10ms resolution. We also write the tick data out to SQLite DB at the same time.
Try rewriting using setlinkondata and control the calculations in the macro that it triggers. ie. Turn calculations off, load data into worksheet, turn calculations back on. The triggered macro will update all tick data in a single calculation cycle.
Our DDE cell formula calls a defined name which contains the text syntax for the DDE Call:
DDE_Command
=OEC_Account&"|"&DDE_TOPIC&"!'"&Symbol&"?"&DDE_COL&"'"
DDE_TOPIC
=INDEX(T_1_H,1,oCol)
DDE_COL
=INDEX(T_1_H,2,oCol)
Sub Start_Links()
' Check for OEC Trader and Initialize SQLite DB
Check_OEC
If Range("g_oec_running") = 1 Then
initialize_db
Reset_DDE
Range("G_Process_Ticks") = 1
' Get all DDE Links and set trigger for just ask/bid/last price updates
Dim aLinks As Variant
Dim i As Long
aLinks = ActiveWorkbook.LinkSources(xlOLELinks)
If Not IsEmpty(aLinks) Then
For i = 1 To UBound(aLinks)
If UCase(Right(aLinks(i), 4)) = "?ASK" Or UCase(Right(aLinks(i), 4)) = "?BID" Or UCase(Right(aLinks(i), 4)) = "LAST" Then
ActiveWorkbook.SetLinkOnData aLinks(i), "get_ticks"
End If
Next i
End If
End If
End Sub
Sub get_ticks()
''' Open DDE Channel to any known piece of data. This forces all pending DDE updates into the worksheet cells in one shot.
Dim ddechan, F1 As Variant
ddechan = Application.DDEInitiate(app:=m_oec, topic:="quote")
F1 = Application.DDERequest(ddechan, "ESH1?Symbol")
Application.DDETerminate ddechan
' Bail out of processing worksheet if no new price data is present
' Serial_Update_range compares the current price data range with the last update set. (Table T1 to Table T2)
; If there is a change in any bid/ask/last the calculation will be >0
m_count = WorksheetFunction.CountIf(Range("Serial_Update_Range"), ">0")
If m_count = 0 Then
Exit Sub
End If
'Update T2 Workbook Range and write new records out to DB
Application.Calculation = xlCalculationManual
Dim AllCells As Range, Cell As Range, xv As String
Set AllCells = Range("Serial_Update_Range")
DB.cnnbegin
For Each Cell In AllCells
If Cell.Value2 > 0 And Cell.Value2 < 1000 Then
Range("index(T_2," & Cell.Value2 & ",)") = Range("index(T_1," & Cell.Value2 & ",)").Value2
DB.do_cmd2 Range("index(T_1," & Cell.Value2 & ",)").Value2
End If
Next Cell
DB.cnncommit
Exit Sub
End Sub
Sub Stop_Links()
' Code to stop updates'
Range("G_Process_Ticks") = 0
Clear_DDE
On Error Resume Next
Dim aLinks As Variant
Dim i As Long
aLinks = ActiveWorkbook.LinkSources(xlOLELinks)
If Not IsEmpty(aLinks) Then
For i = 1 To UBound(aLinks)
ActiveWorkbook.SetLinkOnData aLinks(i), ""
Next i
End If
End Sub
Sub Clear_DDE()
Range("t_1_dde_quote").ClearContents
End Sub
Sub Reset_DDE()
'Reset and rebuild DDE Formulas:
Dim i, j, up_q, up_c, up_c1, up_ticks, up_set
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
i = WorksheetFunction.CountIf(Range("Index(T_1, , 7)"), "<>-1")
Range("t_1_dde_quote").ClearContents
For j = 1 To i
up_set = Range("index(t_1," & j & ",6)")
If up_set = 1 Then
up_q = "index(t_1_dde_quote," & j & ",)"
Range(up_q) = Range("formulas_dde_quote").Formula
Range(up_q) = Range(up_q).Value2
End If
Next j
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub