for marking graphs according to intrisic time model with excel vba

graphmarker.vba

Option Explicit

Public Const iTREND_UP As Integer = 1
Public Const iTREND_DOWN As Integer = 1

Public Const iTRUE As Integer = 1
Public Const iFALSE As Integer = 0

Type trend
    newTrend As Integer    'only zero or one value, not using bool to line up with excel sheet
    trendOvershoot As Integer    'only zero or one value, not using bool to line up with excel sheet
    trendReversal As Integer    'only zero or one value, not using bool to line up with excel sheet
End Type

Type THRESHOLDS
    newLowThreshold As Double
    newHighThreshold As Double
End Type

Public Function ArrayMarketStep(MidRange As Range, percent As Double, firstTrend As Integer, firstLowThres As Double, firstHighThres As Double) As Variant
    Dim vaInMidData As Variant
    vaInMidData = MidRange.Value

    Dim vaOutData As Variant
    ReDim vOut(LBound(vaInMidData, 1) To UBound(vaInMidData, 1), 1 To 7)

    Dim vaCurRowData As Variant
    ReDim vaCurRowData(1 To 1, 1 To 5)

    vaCurRowData(1, 1) = vaInMidData(LBound(vaInMidData, 1), 1)
    vaCurRowData(1, 2) = percent
    vaCurRowData(1, 3) = firstTrend
    vaCurRowData(1, 4) = firstLowThres
    vaCurRowData(1, 5) = firstHighThres

    Dim vOutRowCounter As Long
    Dim vaCalcTemp As Variant
    For vOutRowCounter = LBound(vaInMidData, 1) To UBound(vaInMidData, 1)
        vaCalcTemp = MarketStep(vaCurRowData)
        vOut(vOutRowCounter, 1) = vaCalcTemp(1, 1)
        vOut(vOutRowCounter, 2) = vaCalcTemp(1, 2)
        vOut(vOutRowCounter, 3) = vaCalcTemp(1, 3)
        vOut(vOutRowCounter, 4) = vaCalcTemp(1, 4)
        vOut(vOutRowCounter, 5) = vaCalcTemp(1, 5)
        vOut(vOutRowCounter, 6) = vaCalcTemp(1, 6)
        vOut(vOutRowCounter, 7) = vaCalcTemp(1, 7)
        If vOutRowCounter < UBound(vaInMidData, 1) Then
                vaCurRowData(1, 1) = vaInMidData((vOutRowCounter + 1), 1)
                vaCurRowData(1, 2) = vOut(vOutRowCounter, 1)
                vaCurRowData(1, 3) = vOut(vOutRowCounter, 2)
                vaCurRowData(1, 4) = vOut(vOutRowCounter, 3)
                vaCurRowData(1, 5) = vOut(vOutRowCounter, 4)
        End If
    Next vOutRowCounter
    ArrayMarketStep = vOut
End Function

Public Function RangeMarketStep(inRange As Range) As Variant
    Dim vaInData As Variant
    vaInData = inRange.Value

    Dim vOut() As Variant
    vOut = MarketStep(vaInData)
    RangeMarketStep = vOut
End Function


Public Function MarketStep(vaInArray As Variant) As Variant
    Dim vaInData As Variant
    vaInData = vaInArray

    'inputs from inRange
    Dim mid As Double
    mid = vaInData(1, 1)
    Dim percent As Double
    percent = vaInData(1, 2)
    Dim curTrend As Integer
    curTrend = vaInData(1, 3)
    Dim curlowThres As Double
    curlowThres = vaInData(1, 4)
    Dim curhighThres As Double
    curhighThres = vaInData(1, 5)

    Dim uTrend As trend
    uTrend = TrendCalc(mid, curTrend, curlowThres, curhighThres)

    Dim uThresholds As THRESHOLDS
    uThresholds = ThresholdCalc(uTrend, mid, percent, curlowThres, curhighThres)

    Dim sEventText As String
    sEventText = EventText(uTrend, uThresholds)

    Dim vOut() As Variant
    ReDim vOut(1 To 1, 1 To 7)
    vOut(1, 1) = percent
    vOut(1, 2) = uTrend.newTrend
    vOut(1, 3) = uThresholds.newLowThreshold
    vOut(1, 4) = uThresholds.newHighThreshold
    vOut(1, 5) = uTrend.trendOvershoot
    vOut(1, 6) = uTrend.trendReversal
    vOut(1, 7) = sEventText

    MarketStep = vOut
End Function


Public Function TrendCalc(mid As Double, curTrend As Integer, lowThres As Double, highThres As Double) As trend
    Dim uOut As trend
    uOut.trendOvershoot = iFALSE
    uOut.trendReversal = iFALSE

    If mid > highThres And curTrend = iTREND_UP Then
        uOut.trendOvershoot = iTRUE
        uOut.newTrend = curTrend
    ElseIf mid > highThres And curTrend = iTREND_DOWN Then
        uOut.trendReversal = iTRUE
        uOut.newTrend = iTREND_UP
    ElseIf mid < lowThres And curTrend = iTREND_DOWN Then
        uOut.trendOvershoot = iTRUE
        uOut.newTrend = curTrend
    ElseIf mid < lowThres And curTrend = iTREND_UP Then
        uOut.trendReversal = iTRUE
        uOut.newTrend = iTREND_DOWN
    Else
        uOut.newTrend = curTrend
    End If

    TrendCalc = uOut
End Function


Public Function ThresholdCalc(uNewTrend As trend, curMid As Double, curPercent As Double, curLowThreshold As Double, curHighThreshold As Double) As THRESHOLDS
    Dim uOut As THRESHOLDS
    If NoTrendEvent(uNewTrend) Then
        If uNewTrend.newTrend = iTREND_UP Then
            uOut.newHighThreshold = curHighThreshold
            uOut.newLowThreshold = WorksheetFunction.Max(curLowThreshold, curMid * (1 - curPercent))
        Else    'this is uNewTrend.newTrend = iTREND_DOWN
            uOut.newLowThreshold = curLowThreshold
            uOut.newHighThreshold = WorksheetFunction.Min(curHighThreshold, curMid * (1 + curPercent))
        End If
    Else
        uOut.newLowThreshold = curMid * (1 - curPercent)
        uOut.newHighThreshold = curMid * (1 + curPercent)
    End If
    ThresholdCalc = uOut
End Function

Public Function NoTrendEvent(uTrend As trend) As Boolean
    NoTrendEvent = uTrend.trendOvershoot = iFALSE And uTrend.trendReversal = iFALSE
End Function

Public Function EventText(uTrend As trend, uThresholds As THRESHOLDS) As String
    Dim sOut As String
    If NoTrendEvent(uTrend) Then
        sOut = "NO EVENT"
    ElseIf uTrend.trendOvershoot = iTRUE Then
        If uTrend.newTrend = iTREND_UP Then
            sOut = "TREND: UP OVERSHOOT NLOW: " & uThresholds.newLowThreshold & " NUP: " & uThresholds.newHighThreshold
        Else
            sOut = "TREND: DOWN OVERSHOOT NLOW: " & uThresholds.newLowThreshold & " NUP: " & uThresholds.newHighThreshold
        End If
    ElseIf uTrend.trendReversal = iTRUE Then
        If uTrend.newTrend = iTREND_UP Then
            sOut = "REVERSAL NEW TREND: UP NLOW: " & uThresholds.newLowThreshold & " NUP: " & uThresholds.newHighThreshold
        Else
            sOut = "REVERSAL NEW TREND: DOWN NLOW: " & uThresholds.newLowThreshold & " NUP: " & uThresholds.newHighThreshold
        End If
    Else
        sOut = "ERROR INVALID STATE"
    End If
    EventText = sOut
End Function

http://i.imgur.com/vkztV.png