Indicate if Macro is Running or Has Stopped

I have the following code that runs on a timer all day long. Sometimes I have problems with the macro and it will stop running intraday and occasionally I will not realize that it has stopped for a few hours. Is there a way to add some kind of indication in a cell on my worksheet that the macro is running or has stopped?

Option Explicit
Dim iCount As Integer, iNumber As Integer, rStart As Range

Sub CopyLiveTradeData()
    Application.OnTime TimeValue("09:30:30"), "StartOnTime"

End Sub

Private Sub StartOnTime()
    iCount = 0
    iNumber = 30000
    Workbooks("Historical Data Run (Thomson)_Live_Vertical").Worksheets("Sheet1").Select
    Call OnTimeMacro
End Sub
Private Sub OnTimeMacro()
    If iCount <= iNumber Then
        iCount = iCount + 1
        Application.OnTime Now + TimeValue("00:00:30"), "RunEveryXMinute"
    Else
        Workbooks("Historical Data Run (Thomson)_Live_Vertical").Worksheets("Sheet1").Select
    End If
End Sub


Private Sub RunEveryXMinute()

    Dim rDate As Range
    Dim dt As Date
    Dim rCopyFrom As Range
    Dim rCopyTo As Range
    Dim rTrade As Range
    Dim sh As Worksheet
    Dim iColumnsToSkip As Integer

    iColumnsToSkip = 25
    Set sh = Workbooks("Historical Data Run (Thomson)_Live_Vertical").Worksheets("Sheet1")

    With sh
        Set rDate = .Range("R1")
        dt = rDate.Value
        Set rCopyFrom = .Range("O59").Resize(1, 2)
        Set rTrade = .Range("N82")

        On Error GoTo EF
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        Do While rCopyFrom.Cells(1, 1).Value <> ""
            Set rCopyTo = rTrade
            If rCopyTo.Value <> "" Then
                If rCopyTo.Offset(1, 0).Value <> "" Then
                    Set rCopyTo = rCopyTo.End(xlDown)
                End If
                Set rCopyTo = rCopyTo.Offset(1, 0)
            End If

            Set rCopyTo = rCopyTo.Resize(1, 3)
           
           
        rCopyTo.Cells(1, 1) = rDate.Value
        rCopyTo.Cells(1, 2) = rCopyFrom.Cells(1, 1).Value
        rCopyTo.Cells(1, 3) = rCopyFrom.Cells(1, 2).Value


            With rCopyTo.Font
                .ThemeColor = xlThemeColorDark1
                .ColorIndex = 2
                .TintAndShade = 0
            End With

            Set rCopyFrom = rCopyFrom.Offset(0, iColumnsToSkip)
            Set rTrade = rTrade.Offset(0, iColumnsToSkip)
        Loop
    End With

    Call OnTimeMacro
EF:
    Application.EnableEvents = True
End Sub