vba - How to Automatically stop a Sub running after 10 seconds

'Why does this code not stop after 10 Seconds
'I am now doing as suggested this does not stop
'after 10 secs

Sub test()
Application.OnTime Now + TimeValue("00:00:08"), "TerminateExecution"
ChangeDoubleToDate
End Sub

Sub TerminateExecution()
End
End Sub
Sub ChangeDoubleToDate()
Dim ii As Long
Sheets.Add
ActiveSheet.Name = "Example"
Range("A:E").ColumnWidth = 15
Range("A:E").ClearContents
Range("A1").Select

For ii = 20190101 To 20191234
ActiveCell.Value = ii
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "=MID(RC[-1],1,4)"
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "=MID(RC[-2],5,2)"
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "=MID(RC[-3],7,2)"
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "=DATE(RC[-3],RC[-2],RC[-1])"

ActiveCell.Offset(1, -4).Range("A1").Select
DoEvents
Next
Application.DisplayAlerts = False
Sheets("Example").Delete
Application.DisplayAlerts = True
End Sub