Excel crashing - multiple interacting macros

mhwolog · Jan 28, 2020

Hi,
Please excuse the messy code - I'm entirely self taught and I keep tinkering with the code over time. I have this .xls workbook where I keep separate worksheets for individual share/options trades (file size is 7MB with lots of formulas). I trade overnight, so I have about 4 "sections" of code that interact:
1. calculation section - gets an individual worksheet to calculate/update with the current market price every 8 seconds - the workbook is too slow if trying to calculate the whole workbook at once. [generally used if I am awake and have turned off the looping, and just want to watch a particular trade]
2. Looping through worksheets - selects the active trade worksheets and cycles through them - each WS will recalculate when it is the active sheet. [this functions while i am asleep - to allow the alarm function to trigger if necessary]
3. Timestamp - takes a "snapshot" of each current trade value and market price - 6 times a night
4. Alarm function - will trigger an alarm to wake me up if the market moves a lot overnight.
Up until yesterday the workbook was working fine, apart from maybe 1 crash per night - which usually seemed to occur when I was interacting with the workbook; and I am assuming one of the above background macros triggered or conflicted with another. I had tried some basic error handling to find the problem; and more recently tried to log the activity of different macros to see if I could detect a pattern occurring prior to the crash - but no luck. I had essentially settled on saving frequently and just restarting the workbook when necessary. Sometimes excel will repair the workbook and remove "invalid conditional formatting" - but there isn't a lot of conditional formatting, and it doesn't give me enough information to work out if this is the cause of the crashing.

However, yesterday the workbook started freezing and crashing a lot.... I am not sure whether it is because I added some data/trades to existing worksheets (however, this is something that happens all the time, and hasn't caused any issues before). ? could something in the workbook have become corrupted this day? I tried going back to an earlier dropbox version of the file - but it hasn't solved the problem. I hadn't made any changes to the macros - I did add in one "OFFSET" formula which is volatile - but I have removed it again, and this didn't solve the problem. I currently can't use the calculation/looping listed above - it just crashes. I am just getting by at the moment by switching the whole workbook and macros to manual calculation - and just clicking a button to calculate the active sheet infrequently to update.

I don't know if the macros need to be rewritten more neatly/simplified - and so that there is definitely no conflict between them. Thanks for any help - please see the 4 groups of code below:

CALCULATION SECTION

VBA Code:

Public RecalcOn As Integer
Dim SchedRecalc As Date
Dim EndTimeSchedule As Date
Public RecalcUSposOn As Integer
Public ManualCalcOnly As Boolean
Sub ManualCalOnly()
If ManualCalcOnly = True Then
     ManualCalcOnly = False
     Application.Calculation = xlCalculationAutomatic

     Exit Sub
End If

ManualCalcOnly = True
Application.Calculation = xlCalculationManual

End Sub
Sub StartRecalcUSpos()
Call LogMacro("StartRecalcUSpos", "Start")

On Error GoTo ErrHandler

If ManualCalcOnly = True Then
    Exit Sub
End If

ManualCalcOnly = False

If RecalcOn = 0 Then '1st time triggered
    RecalcOn = 1

    EndTimeSchedule = Now + TimeValue("00:10:00")

    Application.OnTime EndTimeSchedule, "EndTimeUSpos"
    Application.Calculation = xlCalculationManual
    
ElseIf RecalcOn = 1 Then
    Application.OnTime EndTimeSchedule, "EndTimeUSpos", False

    EndTimeSchedule = Now + TimeValue("00:10:00")

    Application.OnTime EndTimeSchedule, "EndTimeUSpos" 'reset timer for 1 hr 30mins
    Application.Calculation = xlCalculationManual
    
End If

RecalcUSposOn = RecalcUSposOn + 1 'zero for first run, greater than 1 its already been clicked once
Call LogMacro("StartRecalcUSpos", "Goingto_RecalcUSpos")

Call RecalcUSpos
Exit Sub

ErrHandler:
Dim strAlarmHTKpath As String, varProc As Variant

strAlarmHTKpath = "C:\users\Leon\dropbox\alarm.exe" 'Must be an exe file, .ahk won't work; Alarm will sound
varProc = Shell(strAlarmHTKpath, 1)

Stop
Resume
End Sub
Sub RecalcUSpos()
Call LogMacro("RecalcUSpos", "start")

On Error GoTo ErrHandler

If ManualCalcOnly = True Then
    Exit Sub
End If
If Left(ActiveSheet.Name, 7) = "Overall" Then
    Exit Sub
End If

If RecalcUSposOn = 0 Then 'looping has been clicked on, which switches this off
    Exit Sub
ElseIf RecalcUSposOn > 1 Then
    RecalcUSposOn = 1
    Exit Sub
End If

If Application.CutCopyMode = 0 Then _
   'otherwise clipboard contents are deleted when calculating
    If Worksheets("Underlying Assets, Settings").Range("J9").Text <> "" Then 'calculation of sheet on
        Worksheets("Underlying Assets, Settings").Calculate
        ActiveSheet.Calculate
    End If
End If

Call LogMacro("RecalcUSpos", "Goingto_StartTimeUSpos")
Call StartTimeUSpos ' need to keep calling the timer, as the ontime only runs once

Exit Sub

ErrHandler:
Dim strAlarmHTKpath As String, varProc As Variant

strAlarmHTKpath = "C:\users\Leon\dropbox\alarm.exe" 'Must be an exe file, .ahk won't work; Alarm will sound
varProc = Shell(strAlarmHTKpath, 1)

Stop
Resume

End Sub

Sub StartTimeUSpos()
Call LogMacro("StartTimeUSpos", "start")

On Error GoTo ErrHandler

If ActiveSheet.Name = "OverallSummary" Then
    ActiveSheet.Calculate
    Exit Sub
End If
If ManualCalcOnly = True Then
    Exit Sub
End If

Dim a As String
a = Worksheets("Underlying Assets, Settings").Range("J9").Text
SchedRecalc = Now + TimeValue(a)
Application.OnTime SchedRecalc, "RecalcUSpos"
Exit Sub

ErrHandler:
Dim strAlarmHTKpath As String, varProc As Variant

strAlarmHTKpath = "C:\users\Leon\dropbox\alarm.exe" 'Must be an exe file, .ahk won't work; Alarm will sound
varProc = Shell(strAlarmHTKpath, 1)

Stop
Resume


End Sub

Sub EndTimeUSpos()
Call LogMacro("EndTimeUSpos", "start")

On Error GoTo ErrHandler

If ManualCalcOnly = True Then
    Exit Sub
End If

On Error Resume Next
Application.OnTime EarliestTime:=SchedRecalc, _
        Procedure:="RecalcUSpos", Schedule:=False
Application.Calculation = xlCalculationAutomatic
RecalcOn = 0
RecalcUSposOn = 0

Call LogMacro("EndTimeUSpos", "Goingto_StartRecalcUSpos")

StartRecalcUSpos
Exit Sub

ErrHandler:
Dim strAlarmHTKpath As String, varProc As Variant

strAlarmHTKpath = "C:\users\Leon\dropbox\alarm.exe" 'Must be an exe file, .ahk won't work; Alarm will sound
varProc = Shell(strAlarmHTKpath, 1)

Stop
Resume

End Sub

LOOPING SECTION

VBA Code:

Public SchedLoop As Date
Public bint As Integer
Public cString As String
Public xCount As Integer
Public SNarray As Variant
Public ResetSilexActv As Boolean
Public SPXNA As Integer
Public StartLoopingOn As Integer
Public RestartLoopTime1
Public RestartLoopTime2
Public RestartLoopTime3

Sub OpenworkbookLoopingTimer()
Call LogMacro("OpenworkbookLoopingTimer", "Start")

On Error GoTo ErrHandler

'start this when workbook opens
Dim a As String
Dim b As String
    
    
    a = Worksheets("Underlying Assets, Settings").Range("I20").Value
    b = Worksheets("Underlying Assets, Settings").Range("J20").Value

If Weekday(Now, vbMonday) < 6 Then 'If day of week is Monday - Saturday
    Application.OnTime TimeValue(a), "StartLooping"  'Set timer to start at the trading open

End If
    
    '***If it's winter with start time prior to midnight - operator should be OR
    '***If it's summer with start time/end time same day - operator should be AND
If Right(a, 2) = "PM" Then
    If Time > TimeValue(a) Or Time < TimeValue(b) Then 'If excel reopens between these times, then should start
        Call LogMacro("OpenworkbookLoopingTimer", "Goingto_StartLoopIfInactive")
        Call StartLoopIfInactive
    
    End If
Else
    If Time > TimeValue(a) And Time < TimeValue(b) Then 'If excel reopens between these times, then should start
        Call LogMacro("OpenworkbookLoopingTimer", "Goingto_StartLoopIfInactive")
        Call StartLoopIfInactive
    
    End If
End If

Exit Sub

ErrHandler:
Dim strAlarmHTKpath As String, varProc As Variant

strAlarmHTKpath = "C:\users\Leon\dropbox\alarm.exe" 'Must be an exe file, .ahk won't work; Alarm will sound
varProc = Shell(strAlarmHTKpath, 1)

Stop
Resume

End Sub


Sub StartLooping()
'ActiveWorkbook.Save   Seemed to be causing excel to crash, especially when spreadsheet first opened
Call LogMacro("StartLooping", "Start")
On Error GoTo ErrHandler

If ManualCalcOnly = True Then
    Exit Sub
End If

'Call StopLooping 'often need to stop looping first to get looping to start, so I put this here.
'SEEMS TO MAKE LOOPING GO TOO FAST SO TURNED THIS LINE OFF

ManualCalcOnly = False
'creates array of worksheets to loop through, and then calls loop_through_all_sheets

'May consider setting up an integer here to clear SNarray and redo it depending on how many times this sub is called
' but at the moment have just left it.  It looks like it should resetup the array each time this is called anyway - which
'is what you want if new trades get added in.
Call LogMacro("StartLooping", "Goingto_HideRibbon")

Call HideRibbon

    Worksheets("Index").Range("C3").Value = "Loop"
    Worksheets("Index").Range("C2").Value = ""

Call LogMacro("StartLooping", "Goingto_CreateSnArray")

Call CreateSnArray
   
    
    StartLoopingOn = StartLoopingOn + 1
    Call LogMacro("StartLooping", "SAVE")

    ActiveWorkbook.Save
    Call LogMacro("StartLooping", "Goingto_loop_through_all_worksheets")
    Call loop_through_all_worksheets
    
Exit Sub

ErrHandler:
Dim strAlarmHTKpath As String, varProc As Variant

strAlarmHTKpath = "C:\users\Leon\dropbox\alarm.exe" 'Must be an exe file, .ahk won't work; Alarm will sound
varProc = Shell(strAlarmHTKpath, 1)

Stop
Resume
    
End Sub
Sub CreateSnArray()
Call LogMacro("CreateSnArray", "start")

On Error GoTo ErrHandler

bint = 0
cString = ""
xCount = 0
SNarray = ""
    
    SPXNA = 0

    bint = 1
    cString = Worksheets("Underlying Assets, Settings").Range("J9").Text
    Dim M As Long
    For M = 1 To ActiveWorkbook.Sheets.Count
        If Left(Sheets(M).Name, 2) = "ST" Or Left(Sheets(M).Name, 2) = "LT" Or Left(Sheets(M).Name, 2) = "Un" Then xCount = xCount + 1
    Next

   
    ReDim SNarray(1 To xCount)
    a = 1
    For i = 1 To Sheets.Count

       If Left(Sheets(i).Name, 2) = "ST" Or Left(Sheets(i).Name, 2) = "LT" Or Left(Sheets(i).Name, 2) = "Un" Then
        
        If Sheets(i).Tab.ColorIndex <> 3 Then 'Red means trade saved, trade no longer active.
            Sheets(i).Tab.ColorIndex = -4142 'reset tab color to no colour
        End If
        
        SNarray(a) = ThisWorkbook.Sheets(i).Name
        Debug.Print SNarray(a)
        a = a + 1
       'Else
        'I = I - 1 'GoTo Findnext
       End If
       
    Next
    
Exit Sub

ErrHandler:
Dim strAlarmHTKpath As String, varProc As Variant

strAlarmHTKpath = "C:\users\Leon\dropbox\alarm.exe" 'Must be an exe file, .ahk won't work; Alarm will sound
varProc = Shell(strAlarmHTKpath, 1)

Stop
Resume
    
End Sub

Sub StopLooping()
Call LogMacro("StopLooping", "start")

On Error GoTo ErrHandler
    Call LogMacro("StopLooping", "Goingto_StopRestartLoopingSchedule")

    Call StopRestartLoopingSchedule
    StartLoopingOn = 0
    RestartLoopTime1 = Now + TimeValue("00:45:00")
    RestartLoopTime2 = Now + TimeValue("01:30:00")
    RestartLoopTime3 = Now + TimeValue("02:15:00")
    Worksheets("Underlying Assets, Settings").Range("D10").Value = RestartLoopTime1
    Worksheets("Underlying Assets, Settings").Range("E10").Value = RestartLoopTime2
    Worksheets("Underlying Assets, Settings").Range("F10").Value = RestartLoopTime3
    Worksheets("Underlying Assets, Settings").Range("D10").NumberFormat = "hh:mm"
    Worksheets("Underlying Assets, Settings").Range("E10").NumberFormat = "hh:mm"
    Worksheets("Underlying Assets, Settings").Range("F10").NumberFormat = "hh:mm"

    Application.OnTime RestartLoopTime1, "StartLoopIfInactive", Schedule:=True
    Application.OnTime RestartLoopTime2, "StartLoopIfInactive", Schedule:=True
    Application.OnTime RestartLoopTime3, "StartLoopIfInactive", Schedule:=True
    
    Worksheets("Index").Range("C3").Value = ""
    Call LogMacro("StopLooping", "Goingto_StartRecalcUSpos")
    
    Call StartRecalcUSpos 'added 2nd oct
    
Exit Sub

ErrHandler:
Dim strAlarmHTKpath As String, varProc As Variant

strAlarmHTKpath = "C:\users\Leon\dropbox\alarm.exe" 'Must be an exe file, .ahk won't work; Alarm will sound
varProc = Shell(strAlarmHTKpath, 1)

Stop
Resume
    
End Sub
Sub StopRestartLoopingSchedule()
   Call LogMacro("StopRestartLoopingSchedule", "start")
   
   On Error Resume Next
   RestartLoopTime1 = Worksheets("Underlying Assets, Settings").Range("D10").Value
   RestartLoopTime2 = Worksheets("Underlying Assets, Settings").Range("E10").Value
   RestartLoopTime3 = Worksheets("Underlying Assets, Settings").Range("F10").Value
   Application.OnTime RestartLoopTi0me1, "StartLoopIfInactive", Schedule:=False
   Application.OnTime RestartLoopTime2, "StartLoopIfInactive", Schedule:=False
   Application.OnTime RestartLoopTime3, "StartLoopIfInactive", Schedule:=False
   Worksheets("Underlying Assets, Settings").Range("D10").Value = ""
   Worksheets("Underlying Assets, Settings").Range("E10").Value = ""
   Worksheets("Underlying Assets, Settings").Range("F10").Value = ""
End Sub

Sub StartLoopIfInactive()

If ManualCalcOnly = True Then
    Exit Sub
End If
   
   Call LogMacro("StartLoopIfInactive", "start")

On Error GoTo ErrHandler

If ActiveSheet.Name = "OverallSummary" Then
    Exit Sub
End If
'If fallen asleep and forgotten to restart looping, checks to see if looping is already on, otherwise restarts.
    'StartLoopingOn = StartLoopingOn + 1 '2nd oct disabled
    If Worksheets("Index").Range("C3").Value = "" Then  '2nd oct new
        Call LogMacro("StartLoopIfInactive", "Goingto_StartLooping")

        Call StartLooping
    End If   '2nd oct new

Exit Sub

ErrHandler:
Dim strAlarmHTKpath As String, varProc As Variant

strAlarmHTKpath = "C:\users\Leon\dropbox\alarm.exe" 'Must be an exe file, .ahk won't work; Alarm will sound
varProc = Shell(strAlarmHTKpath, 1)

Stop
Resume

End Sub
Sub StartTimerLoop()
Call LogMacro("StartTimerLoop", "start")

On Error GoTo ErrHandler

If Application.CutCopyMode = 0 Then _
   'otherwise clipboard contents are deleted when calculating
    If Worksheets("Underlying Assets, Settings").Range("J9").Text <> "" Then 'calculation of sheet on
        Worksheets("Underlying Assets, Settings").Calculate
        ActiveSheet.Calculate
    End If
End If

SchedLoop = Now + TimeValue(cString)
Application.OnTime SchedLoop, "loop_through_all_worksheets"

Exit Sub

ErrHandler:
Dim strAlarmHTKpath As String, varProc As Variant

strAlarmHTKpath = "C:\users\Leon\dropbox\alarm.exe" 'Must be an exe file, .ahk won't work; Alarm will sound
varProc = Shell(strAlarmHTKpath, 1)

Stop
Resume

End Sub
Sub loop_through_all_worksheets()
Call LogMacro("loop_through_all_worksheets", "start")

Dim strAlarmHTKpath As String, varProc As Variant

On Error GoTo ErrHandler

' 'If one round of looping already started, then exit this sub
If Worksheets("Index").Range("C3").Text <> "Loop" Then
     Exit Sub
Else
    RecalcUSposOn = 0

End If

Dim a As String
If Application.CutCopyMode = 0 Then _
   'otherwise clipboard contents are deleted when calculating
    If Worksheets("Underlying Assets, Settings").Range("J9").Text <> "" Then 'calculation of sheet on
        'put this in to try and fix silexx alarm going off constantly
        Worksheets("Underlying Assets, Settings").Range("I2").Value = "=" & "SLX|LAST!'$SPX'"
        Worksheets("Underlying Assets, Settings").Calculate
       
        'put this in to try and fix silexx alarm going off constantly
        a = Range("C55").Formula
        Range("C55").Formula = a
            'Cells(r, c).Formula = a = "=" & "IF(W56=" & Chr(34) & "ON" & Chr(34) & ", OFFSET(C264, 0, G56-3), IF($D$55=" & """" & ",IF($B$55=" & Chr(34) & "SPX" & Chr(34) & ",SLX|LAST!'$SPX',SLX|LAST!'$RUT'), D55))"
        ActiveSheet.Calculate
        ActiveSheet.Calculate

    End If
End If

    bint = bint + 1
    If bint > xCount Then
        bint = 1
    End If
    
    
Worksheets(SNarray(bint)).Activate

        ActiveSheet.Calculate

If ActiveSheet.Name = "Underlying Assets, Settings" Then
Dim M As String 'Put in this next section to try and stop alarm triggering out of trading hours/after close.
Dim n As String
    
    M = Worksheets("Underlying Assets, Settings").Range("I20").Value 'start of trading hrs
    n = Worksheets("Underlying Assets, Settings").Range("J20").Value ' end of trading hrs

    If Right(M, 2) = "PM" Then
        If Time < TimeValue(M) And Time > TimeValue(n) Then 'During these times (in winter) the alarm should not be active
        
            GoTo Skip
    
        End If
    Else
        If Time < TimeValue(M) Or Time > TimeValue(n) Then 'During these times (in summer) the alarm should not be active
        
            GoTo Skip
    
        End If
    End If
    If IsNumeric(Worksheets("Underlying Assets, Settings").Range("I2")) = False Then
        ResetSilexActv = True
        SPXNA = SPXNA + 1
    ElseIf IsNumeric(Worksheets("Underlying Assets, Settings").Range("O20")) = False Then
        ResetSilexActv = True
        SPXNA = SPXNA + 1

'This section checks to make sure the market price is changing with each cycle - otherwise the broker platform is down and the alarm sounds.
    ElseIf Worksheets("Underlying Assets, Settings").Range("O20").Value = "" Then
        Worksheets("Underlying Assets, Settings").Range("O20").Value = Worksheets("Underlying Assets, Settings").Range("I2").Value 'spx value
    ElseIf Worksheets("Underlying Assets, Settings").Range("O21").Value = "" Then
        Worksheets("Underlying Assets, Settings").Range("O21").Value = Worksheets("Underlying Assets, Settings").Range("I2").Value
        If Worksheets("Underlying Assets, Settings").Range("O21").Value <> Worksheets("Underlying Assets, Settings").Range("O20").Value Then
            ResetSilexActv = True
        End If
    ElseIf Worksheets("Underlying Assets, Settings").Range("O22").Value = "" Then
        Worksheets("Underlying Assets, Settings").Range("O22").Value = Worksheets("Underlying Assets, Settings").Range("I2").Value
        If Worksheets("Underlying Assets, Settings").Range("O22").Value <> Worksheets("Underlying Assets, Settings").Range("O21").Value Then
            ResetSilexActv = True
        End If
    ElseIf Worksheets("Underlying Assets, Settings").Range("O23").Value = "" Then
        Worksheets("Underlying Assets, Settings").Range("O23").Value = Worksheets("Underlying Assets, Settings").Range("I2").Value
        If Worksheets("Underlying Assets, Settings").Range("O23").Value <> Worksheets("Underlying Assets, Settings").Range("O22").Value Then
            ResetSilexActv = True
        End If
    ElseIf Worksheets("Underlying Assets, Settings").Range("O24").Value = "" Then
        Worksheets("Underlying Assets, Settings").Range("O24").Value = Worksheets("Underlying Assets, Settings").Range("I2").Value
        If Worksheets("Underlying Assets, Settings").Range("O24").Value <> Worksheets("Underlying Assets, Settings").Range("O23").Value Then
            ResetSilexActv = True
        End If
        
    ElseIf Worksheets("Underlying Assets, Settings").Range("O25").Value = "" Then
        Worksheets("Underlying Assets, Settings").Range("O25").Value = Worksheets("Underlying Assets, Settings").Range("I2").Value
        If Worksheets("Underlying Assets, Settings").Range("O25").Value <> Worksheets("Underlying Assets, Settings").Range("O24").Value Then
            ResetSilexActv = True
        End If
    ElseIf Worksheets("Underlying Assets, Settings").Range("O26").Value = "" Then
        Worksheets("Underlying Assets, Settings").Range("O26").Value = Worksheets("Underlying Assets, Settings").Range("I2").Value
        If Worksheets("Underlying Assets, Settings").Range("O26").Value <> Worksheets("Underlying Assets, Settings").Range("O25").Value Then
            ResetSilexActv = True
        End If
    ElseIf Worksheets("Underlying Assets, Settings").Range("O27").Value = "" Then
        Worksheets("Underlying Assets, Settings").Range("O27").Value = Worksheets("Underlying Assets, Settings").Range("I2").Value
        If Worksheets("Underlying Assets, Settings").Range("O27").Value <> Worksheets("Underlying Assets, Settings").Range("O26").Value Then
            ResetSilexActv = True
        End If
        
    ElseIf Worksheets("Underlying Assets, Settings").Range("O28").Value = "" Then
        Worksheets("Underlying Assets, Settings").Range("O28").Value = Worksheets("Underlying Assets, Settings").Range("I2").Value
        Call StartRecalcUSpos 'see if this will stop inactivity alarm going off
        If Worksheets("Underlying Assets, Settings").Range("O28").Value <> Worksheets("Underlying Assets, Settings").Range("O27").Value Then
            ResetSilexActv = True
        End If
    ElseIf Worksheets("Underlying Assets, Settings").Range("O29").Value = "" Then
        Worksheets("Underlying Assets, Settings").Range("O29").Value = Worksheets("Underlying Assets, Settings").Range("I2").Value
        If Worksheets("Underlying Assets, Settings").Range("O29").Value <> Worksheets("Underlying Assets, Settings").Range("O28").Value Then
            ResetSilexActv = True
        End If
    ElseIf Worksheets("Underlying Assets, Settings").Range("O30").Value = "" Then
        Worksheets("Underlying Assets, Settings").Range("O30").Value = Worksheets("Underlying Assets, Settings").Range("I2").Value
        If Worksheets("Underlying Assets, Settings").Range("O30").Value <> Worksheets("Underlying Assets, Settings").Range("O29").Value Then
            ResetSilexActv = True
        End If
        
    ElseIf Worksheets("Underlying Assets, Settings").Range("O31").Value = "" Then
        Worksheets("Underlying Assets, Settings").Range("O31").Value = Worksheets("Underlying Assets, Settings").Range("I2").Value
        If Worksheets("Underlying Assets, Settings").Range("O31").Value <> Worksheets("Underlying Assets, Settings").Range("O30").Value Then
            ResetSilexActv = True
        End If
    ElseIf Worksheets("Underlying Assets, Settings").Range("O32").Value = "" Then
        Worksheets("Underlying Assets, Settings").Range("O32").Value = Worksheets("Underlying Assets, Settings").Range("I2").Value
        If Worksheets("Underlying Assets, Settings").Range("O32").Value <> Worksheets("Underlying Assets, Settings").Range("O31").Value Then
            ResetSilexActv = True
        End If
    ElseIf Worksheets("Underlying Assets, Settings").Range("O33").Value = "" Then
        Worksheets("Underlying Assets, Settings").Range("O33").Value = Worksheets("Underlying Assets, Settings").Range("I2").Value
        If Worksheets("Underlying Assets, Settings").Range("O33").Value <> Worksheets("Underlying Assets, Settings").Range("O32").Value Then
            ResetSilexActv = True
        End If
        
    ElseIf Worksheets("Underlying Assets, Settings").Range("O34").Value = "" Then
        Worksheets("Underlying Assets, Settings").Range("O34").Value = Worksheets("Underlying Assets, Settings").Range("I2").Value
        If Worksheets("Underlying Assets, Settings").Range("O34").Value <> Worksheets("Underlying Assets, Settings").Range("O33").Value Then
            ResetSilexActv = True
        ElseIf Worksheets("Underlying Assets, Settings").Range("O34").Value = Worksheets("Underlying Assets, Settings").Range("O33").Value Then
            strAlarmHTKpath = "C:\users\Leon\dropbox\alarm.exe" 'Must be an exe file, .ahk won't work; Alarm will sound
            varProc = Shell(strAlarmHTKpath, 1)
            MsgBox ("Silex hasn't updated for 5-6 minutes")
            Worksheets("Underlying Assets, Settings").Range("O20:O34").ClearContents
          
        End If
    End If
    
End If

If ResetSilexActv = True Then
    Worksheets("Underlying Assets, Settings").Range("O20:O34").ClearContents

    ResetSilexActv = False
End If
If SPXNA > 9 Then 'SPX price is stuck on N/A error
    strAlarmHTKpath = "C:\users\Leon\dropbox\alarm.exe" 'Must be an exe file, .ahk won't work; Alarm will sound
    varProc = Shell(strAlarmHTKpath, 1)
    MsgBox ("Silex hasn't updated for 5-6 minutes")
    Worksheets("Underlying Assets, Settings").Range("O20:O34").ClearContents
    
End If
    
Skip:
Call LogMacro("loop_through_all_worksheets", "Goingto_StartTimerLoop")

Call StartTimerLoop

Exit Sub

ErrHandler:

strAlarmHTKpath = "C:\users\Leon\dropbox\alarm.exe" 'Must be an exe file, .ahk won't work; Alarm will sound
varProc = Shell(strAlarmHTKpath, 1)

Stop
Resume

End Sub

TIMESTAMP

VBA Code:

Public ManualTTS As Boolean

Sub ManualTradeTimeStamp()
   ManualTTS = True
   Call TradeTimestamp
End Sub
Sub setTimesTradeTimeStamp()
Call LogMacro("setTimesTradeTimeStamp", "Start")
Application.OnTime TimeValue(Worksheets("Underlying Assets, Settings").Range("Q20").Text), "RunTradeTimestamp"
Application.OnTime TimeValue(Worksheets("Underlying Assets, Settings").Range("Q21").Text), "RunTradeTimestamp"
Application.OnTime TimeValue(Worksheets("Underlying Assets, Settings").Range("Q22").Text), "RunTradeTimestamp"
Application.OnTime TimeValue(Worksheets("Underlying Assets, Settings").Range("Q23").Text), "RunTradeTimestamp"
Application.OnTime TimeValue(Worksheets("Underlying Assets, Settings").Range("Q24").Text), "RunTradeTimestamp"
Application.OnTime TimeValue(Worksheets("Underlying Assets, Settings").Range("Q25").Text), "RunTradeTimestamp"
Application.OnTime TimeValue(Worksheets("Underlying Assets, Settings").Range("J20").Text), "CloseDimmer"
Dim closetime1 As String
Dim closetime2 As String
Dim closetime3 As String

closetime1 = TimeValue(Worksheets("Underlying Assets, Settings").Range("J20").Text)
closetime2 = TimeValue(Worksheets("Underlying Assets, Settings").Range("J20").Text) + TimeValue("00:20:00")
closetime3 = TimeValue(Worksheets("Underlying Assets, Settings").Range("J20").Text) + TimeValue("00:40:00")
Application.OnTime closetime1, "Stoplooping", Schedule:=True
' Application.OnTime closetime2, "Stoplooping", Schedule:=True  'This may cause problems if the program is closed at closing time, as it will reopen excel
' Application.OnTime closetime3, "Stoplooping", Schedule:=True

End Sub
Sub CloseDimmer()

Dim sDimmer As String

sDimmer = "TASKKILL /F /IM dimmer.exe"
Shell sDimmer, vbHide

End Sub
Sub RunTradeTimestamp()
Call LogMacro("RunTradeTimestamp", "Start")

On Error GoTo ErrHandler
Call LogMacro("RunTradeTimestamp", "Goingto_CreateSnArray")

Call CreateSnArray

Dim u As Integer
For u = 1 To (xCount - 1) Step 1

waitandtryagain:
    If Application.CutCopyMode = 0 Then _
       'otherwise clipboard contents are deleted when calculating
                  
            Worksheets(SNarray(u)).Activate
            Worksheets("Underlying Assets, Settings").Calculate
            Worksheets(SNarray(u)).Calculate
            Call LogMacro("RunTradeTimestamp", "Goingto_TradeTimestamp")

            Call TradeTimestamp
    Else
        GoTo waitandtryagain
    End If

Next u


Exit Sub

ErrHandler:
Dim strAlarmHTKpath As String, varProc As Variant

strAlarmHTKpath = "C:\users\Leon\dropbox\alarm.exe" 'Must be an exe file, .ahk won't work; Alarm will sound
varProc = Shell(strAlarmHTKpath, 1)

Stop
Resume

End Sub
Sub TradeTimestamp()
Call LogMacro("TradeTimestamp", "start")

On Error GoTo ErrHandler

Dim o As Integer
Dim p As Integer
'Check previous timestamps are in correct spot
If ActiveSheet.Name = "Underlying Assets, Settings" Then
    Exit Sub
End If
If Left(ActiveSheet.Name, 7) = "Overall" Then
    Exit Sub
End If

Start:
If Cells(267, 2).Value = "Option $" Then
    If Cells(262, 1).Value > 0 Then
        p = Cells(262, 1).Value
        If Cells(262, p).Value = "" Then
            GoTo Allok
        Else
            GoTo Findoptions
        End If
    End If
End If

Findoptions:
For o = 260 To 275 Step 1
    If Cells(o, 2).Value = "Option $" Then
        p = 267 - o
        If p < 0 Then  'delete rows
            p = Abs(p)
            Range(Cells(250, 1), Cells(249 + p, 256)).EntireRow.Delete
        Else ' p is positive so insert rows
            Range(Cells(250, 1), Cells(249 + p, 256)).EntireRow.Insert
        End If
        GoTo Start
    End If
Next o

Allok:
Dim c As Integer
Dim i As Integer
If ManualTTS = True Then
    ManualTTS = False
    'continue
ElseIf Cells(263, p - 1).Text = "TIME" Then
    'continue
ElseIf Hour(Cells(263, p - 1).Value) = Hour(Worksheets("Underlying Assets, Settings").Range("J5")) Then
    Exit Sub 'i.e already done onetimestamp this hr
End If

c = ActiveSheet.Range("A262").Value
If ActiveSheet.Name = "Underlying Assets, Settings" Then
    Exit Sub
End If
Dim a As String
Dim b As String
    
    a = Worksheets("Underlying Assets, Settings").Range("I20").Value 'start of trading hrs
    b = Worksheets("Underlying Assets, Settings").Range("J20").Value ' end of trading hrs

If Right(a, 2) = "PM" Then
    If Time < TimeValue(a) And Time > TimeValue(b) Then 'During these times (in winter) the alarm should not be active
        
        Exit Sub
    
    End If
Else
    If Time < TimeValue(a) Or Time > TimeValue(b) Then 'During these times (in summer) the alarm should not be active
        
        Exit Sub
    
    End If
End If

ActiveSheet.Range("A262").Value = c + 1

ActiveSheet.Cells(258, c).Value = ActiveSheet.Range("B31").Value 'P/L $
ActiveSheet.Cells(259, c).Value = ActiveSheet.Range("C31").Value 'P/L %
ActiveSheet.Cells(260, c).Value = Worksheets("Underlying Assets, Settings").Range("H17").Value 'Prev Close VIX
ActiveSheet.Cells(261, c).Value = Worksheets("Underlying Assets, Settings").Range("H16").Value 'Prev Close SPX
ActiveSheet.Cells(262, c).Value = DateValue(Worksheets("Underlying Assets, Settings").Range("I5").Value) 'Date
ActiveSheet.Cells(263, c).Value = Worksheets("Underlying Assets, Settings").Range("J5").Value 'Time
ActiveSheet.Cells(264, c).Value = ActiveSheet.Range("C55").Value 'SPX
ActiveSheet.Cells(265, c).Value = Worksheets("Underlying Assets, Settings").Range("K2").Value 'VIX
ActiveSheet.Cells(266, c).Value = Worksheets("Underlying Assets, Settings").Range("I3").Value 'RFR

For i = 67 To 250 Step 1
    If ActiveSheet.Cells(i, 6).Value = "C" Or ActiveSheet.Cells(i, 6).Value = "P" Then
        ActiveSheet.Cells(i + 200, c).Value = ActiveSheet.Cells(i, 11).Value
    Else
        Exit Sub
    End If
Next i

Exit Sub

ErrHandler:
Dim strAlarmHTKpath As String, varProc As Variant

strAlarmHTKpath = "C:\users\Leon\dropbox\alarm.exe" 'Must be an exe file, .ahk won't work; Alarm will sound
varProc = Shell(strAlarmHTKpath, 1)

Stop
Resume

End Sub

ALARM

VBA Code:

Public Function Alarm(cell, condition, Optional CellRef As String) As Boolean
'''Call LogMacro("Alarm", "Start")
'Sub test()
If CellRef = "" Then
'do nothing, cellreference contents are blank or not provided
Else
condition = CellRef ' override the condition in the function
End If



Dim a As String
Dim b As String
    
    a = Worksheets("Underlying Assets, Settings").Range("I20").Value 'start of trading hrs
    b = Worksheets("Underlying Assets, Settings").Range("J20").Value ' end of trading hrs

    Dim strAlarmHTKpath As String, varProc As Variant
If Right(a, 2) = "PM" Then
    If Time < TimeValue(a) And Time > TimeValue(b) Then 'During these times (in winter) the alarm should not be active
        
        GoTo Skip
    
    End If
Else
    If Time < TimeValue(a) Or Time > TimeValue(b) Then 'During these times (in summer) the alarm should not be active
        
        GoTo Skip
    
    End If
End If

    Debug.Print "Alarm: " & cell.Address
    
    On Error GoTo ErrHandler
    
    If Evaluate(cell.Value & condition) Then
        If Worksheets("Index").Range("C2").Text = "1" Then 'Only trigger alarm for underlyings page
            If cell.Parent.Name = "Underlying Assets, Settings" Then GoTo ActivateAlarm

            If cell.Parent.Name <> "Underlying Assets, Settings" Then Exit Function
        
        ElseIf Worksheets("Index").Range("C2").Text <> "" Then 'Alarm is disabled altogether
         'strAlarmHTKpath = "C:\users\Leon\dropbox\alarm.exe" 'Alarm will not sound
         'should it say exit function here, or do I still want alarm to = true???
        Else ' alarm is active
ActivateAlarm:
            If Range("M2") = True Then 'alarms disabled on this page by tickbox
                'do nothing, don't trigger alarm
            Else
                If cell.Parent.Name = "Underlying Assets, Settings" Then 'testing to eliminate false alarms
                    Worksheets("Underlying Assets, Settings").Calculate 'testing to eliminate false alarms
                    If Worksheets("Underlying Assets, Settings").Range("M32").Value = "" Then
                        Exit Function
                    End If
                    If Evaluate(cell.Value & condition) Then
                            
                        strAlarmHTKpath = "C:\users\Leon\dropbox\alarm.exe" 'Must be an exe file, .ahk won't work; Alarm will sound
                        varProc = Shell(strAlarmHTKpath, 1)
                        Sheets(cell.Parent.Name).Activate
                        Dim CallerRows As Long
                        Dim CallerCols As Long
                        Dim CallerAddr As String
                            With Application.Caller
                                CallerRows = .Rows.Count
                                CallerCols = .Columns.Count
                                CallerAddr = .Address
                            End With
                        MsgBox (CallerAddr) & " " & "L34cell/I2/M32" & Worksheets("Underlying Assets, Settings").Range("L34").Text & " " & Worksheets("Underlying Assets, Settings").Range("I2").Value & " " & Worksheets("Underlying Assets, Settings").Range("M32").Value
                    End If
                Else
                    strAlarmHTKpath = "C:\users\Leon\dropbox\alarm.exe" 'Must be an exe file, .ahk won't work; Alarm will sound
                    varProc = Shell(strAlarmHTKpath, 1)
                End If
            End If
         'If cell.Parent.Name <> Worksheets("Index").Range("D2").Text Then
            ''''DISABLED THIS BECAUSE IT KEPT REPEATING UP MsgBox (cell.Parent.Name)  ' display where alarm is coming from; possible alternative to timestamp
         'End If
        End If
        Alarm = True
        'If Sheets(cell.Parent.Name).Tab.ColorIndex <> 6 Then
        '    Sheets(cell.Parent.Name).Range("J4").Value = Sheets(cell.Parent.Name).Tab.ColorIndex
            Sheets(cell.Parent.Name).Tab.ColorIndex = 6
        'End If
            'Do While Worksheets("Index").Range("D2").Text <> ""
                'DoEvents

                'Application.Wait (Now + TimeValue("0:05:00"))
                'Worksheets("Index").Range("D2").Text = ""
            'Loop
        Exit Function
    End If
    
ErrHandler:
        Alarm = False
Skip:
End Function

offthelip · Jan 28, 2020

Looking through your code I can see you are creating a large number of call to application ontime. This can cause a problem with EXCEL and could easily be the cause of your crashing.
I have written may applications which are calling all sorts of different things at different and varying times without any problem. (Including a realtime trading system) The way to do this and keep it all under control is to write your own scheduler, which just keeps calling itself using the minimum interval of time that you are interested in. A simple scheduler is shown in this thread, ( somebody else was having similar problem ) Running macros at set times

mhwolog · Jan 29, 2020

Thank you offthelip - I reduced the number of application ontime's - and cleaned them up with the scheduler as you suggested. I have also significantly shortened my code, as there were a lot of unnecessary loops. So far so good, no crashes and the WB is working as normal. I will see how it goes over the next couple of days.
Thanks,

Excel crashing - multiple interacting macros

mhwolog

New Member

Excel Facts

offthelip

Well-known Member

mhwolog

New Member

Similar threads

Forum statistics

Share this page

Excel crashing - multiple interacting macros

mhwolog

New Member

Excel Facts

offthelip

Well-known Member

mhwolog

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock