Excel MVP's - VBA Code Optimization Request

[robertgama]

I was helping out another forum member with a solution to the following problem:
http://www.mrexcel.com/forum/showthread.php?t=596276

I created a working code solution, but it has to be optimized. Can one of the VBA experts out there make some suggestions to significantly speed up this code for it.

The file can be downloaded here:
https://docs.google.com/open?id=0B1DOEckGTf-SMDhjNzEzYmUtNmEyMS00YmU5LTlkNjQtYzA3ZDJhMDJmYzQw

You can view it running here:
http://www.youtube.com/watch?v=kaaX3MaiKFw

Here is the code:

Dim runTime

Sub setRunSchedule()
    runTime = Now + TimeValue("00:00:01")
    Application.OnTime runTime, "CheckValue"
End Sub

Sub CheckValue()
    If UCase(Range("stop").Value) <> "Y" Then
        Calculate
        Range("A1").Value = runTime
        Call setRunSchedule
        'comment out line below when your feed is putting the stock price in B3
        Call simulateStockPrice
        Call testValue
    End If
End Sub

Sub simulateStockPrice()
    Dim stockPrice As Long
    Dim priceChange As Double

    Randomize
    priceChange = Application.WorksheetFunction.RandBetween(-14, 14)
    stockPrice = Range("stockPrice").Value + priceChange
    Range("stockPrice").Value = stockPrice
    
End Sub
Sub NewPriceRange(stockPrice As Long)
    Range("openPrice").Offset(-6 + Range("currentRow").Value, 0).Value = stockPrice
    Range("openPrice").Offset(-6 + Range("currentRow").Value, 1).Value = stockPrice
    Range("openPrice").Offset(-6 + Range("currentRow").Value, 2).Value = stockPrice
    lowestPrice = stockPrice
    highestPrice = stockPrice
End Sub
Sub testValue()
    Dim lowestPrice As Long
    Dim highestPrice As Long
    Dim curPrice As Long
    Dim openPrice As Long
    Dim priceRange As Integer
    Dim priceInterval As Integer
    Dim closeTime As Date
    Dim changeDirection As Integer
    Dim i As Integer

    Const millisecond As Double = (1# / (24# * 60# * 60# * 1000#))
    
    If Range("openPrice").Offset(-6 + Range("currentRow").Value, 0).Value = "" Then
        Call NewPriceRange(Range("stockPrice").Value)
    End If
    
    closeTime = runTime
    curPrice = Range("stockPrice").Value
    openPrice = Range("openPrice").Offset(-6 + Range("currentRow").Value, 0).Value
    
    lowestPrice = Range("openPrice").Offset(-6 + Range("currentRow").Value, 1).Value
    highestPrice = Range("openPrice").Offset(-6 + Range("currentRow").Value, 2).Value
    If curPrice < lowestPrice Then
        lowestPrice = curPrice
    ElseIf curPrice > highestPrice Then
        highestPrice = curPrice
    End If
    priceRange = highestPrice - lowestPrice
    priceInterval = Range("priceInterval").Value
    
    i = 0
    If priceRange > priceInterval Then
        If curPrice = highestPrice Then
            changeDirection = 1
        ElseIf curPrice = lowestPrice Then
            changeDirection = -1
        End If
        Do
            If changeDirection = 1 Then
                highestPrice = lowestPrice + priceInterval
                Range("openPrice").Offset(-6 + Range("currentRow").Value, 1).Value = lowestPrice
                Range("openPrice").Offset(-6 + Range("currentRow").Value, 2).Value = highestPrice
                Range("openPrice").Offset(-6 + Range("currentRow").Value, 3).Value = priceInterval
                Range("openPrice").Offset(-6 + Range("currentRow").Value, 4).Value = highestPrice
                lowestPrice = highestPrice + 1
                openPrice = lowestPrice
                Range("openPrice").Offset(-6 + Range("currentRow").Value, 5).Value = CDbl(closeTime) + millisecond * 10 * i 'DateAdd("s", i, closeTime)
                priceRange = priceRange - (priceInterval + 1)
            ElseIf changeDirection = -1 Then
                lowestPrice = highestPrice - priceInterval
                Range("openPrice").Offset(-6 + Range("currentRow").Value, 1).Value = lowestPrice
                Range("openPrice").Offset(-6 + Range("currentRow").Value, 2).Value = highestPrice
                Range("openPrice").Offset(-6 + Range("currentRow").Value, 3).Value = priceInterval
                Range("openPrice").Offset(-6 + Range("currentRow").Value, 4).Value = lowestPrice
                highestPrice = lowestPrice - 1
                openPrice = highestPrice
                Range("openPrice").Offset(-6 + Range("currentRow").Value, 5).Value = DateAdd("s", i, closeTime)
                priceRange = priceRange - (priceInterval + 1)
            End If
            Range("openPrice").Offset(-6 + Range("currentRow").Value, 0).Value = openPrice
            i = i + 1
        Loop Until priceRange < priceInterval
        If changeDirection = 1 Then
            Range("openPrice").Offset(-6 + Range("currentRow").Value, 1).Value = openPrice
            Range("openPrice").Offset(-6 + Range("currentRow").Value, 2).Value = openPrice + priceRange
        Else
            Range("openPrice").Offset(-6 + Range("currentRow").Value, 1).Value = openPrice - priceRange
            Range("openPrice").Offset(-6 + Range("currentRow").Value, 2).Value = openPrice
        End If
        Range("openPrice").Offset(-6 + Range("currentRow").Value, 3).Value = priceRange
    ElseIf priceRange <= priceInterval Then
        Range("openPrice").Offset(-6 + Range("currentRow").Value, 1).Value = lowestPrice
        Range("openPrice").Offset(-6 + Range("currentRow").Value, 2).Value = highestPrice
        Range("openPrice").Offset(-6 + Range("currentRow").Value, 3).Value = priceRange
    End If
End Sub

Sub ClearValues()
    Range("A6").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    Range("A6").Select
    Range("stop").Value = "n"
End Sub

Thanks,

Rob.