Formula to calculate percentage difference between peak and trough across a sequence of values?

[Rich_B]

Hi

I have a formula that calculates a thousand values that increase/decrease at irregular intervals but that increase overall across the distribution of 1000. Not dissimilar to a 'three steps forward, two steps back' type scenario.

eg. 10, 12, 15, 16, 18, 14, 13, 21, 24, 28, 17, 19, 29, 32, 36, 39, 37, 38, 42, 50, 42, 35, 25, 39, 48, 52, 55, 61, 69, 75

What I would like is a formula that reads through the sequence from start to finish once without looping back to the start and that finds the largest peak to subsequent trough drawdown and expresses this as a percentage. So for the distribution of 30 values above the largest peak to subsequent trough drawdown is 50 down to 25 i.e. 50%.

Is such a formula possible?

Any help greatly appreciated.

Rich

 

[NeonRedSharpie]

Function PEAKS(rng As Range) As Variant



Dim arr() As Variant
Dim peak As Variant
Dim valley As Variant


Dim newPeak As Boolean
Dim newValley As Boolean


peak = 0.0000001
valley = 10000000


arr = rng


Debug.Print (arr(1, 1))
Debug.Print (arr(2, 1))




For x = 2 To UBound(arr)


    If x = UBound(arr) Then
        If arr(x, 1) > peak Then peak = arr(x, 1)
        If arr(x, 1) < valley Then valley = arr(x, 1)
        If (peak - valley) / peak > pval Then pval = (peak - valley) / peak
        GoTo finish
    End If


    If arr(x, 1) > arr(x - 1, 1) Then
        Select Case newValley
            Case True
                GoTo calc:
            Case False
upnext:
                peak = arr(x, 1)
                newPeak = True
                newValley = False
        End Select
    End If
    
    If arr(x, 1) < arr(x - 1, 1) Then
        valley = arr(x, 1)
        newPeak = False
        newValley = True
    End If




Next x
finish:
PEAKS = pval


Exit Function


calc:
If (peak - valley) / peak > pval Then pval = (peak - valley) / peak
peak = 0
valley = 500
    
GoTo upnext:




End Function

Here's a custom function. Call it with PEAKS(A1:A30) for example. It can be used in your workbook.


edited again to make a slight change.

 

[NeonRedSharpie]

For x = 2 To UBound(arr)    
    If x = 2 Then
        Select Case arr(x, 1)
            Case Is > arr(x - 1, 1)
                peak = arr(x, 1)
                valley = arr(x - 1, 1)
                GoTo calc
            Case Is < arr(x - 1, 1)
                peak = arr(x - 1, 1)
                valley = arr(x, 1)
        End Select
        
    End If
    
    If x = UBound(arr) Then
        If arr(x, 1) > peak Then peak = arr(x, 1)
        If arr(x, 1) < valley Then valley = arr(x, 1)
        If (peak - valley) / peak > pval Then pval = (peak - valley) / peak
        GoTo finish
    End If


    If arr(x, 1) > arr(x - 1, 1) Then
        Select Case newValley
            Case True
                GoTo calc:
            Case False
upnext:
                peak = arr(x, 1)
                newPeak = True
                newValley = False
        End Select
    End If
    
    If arr(x, 1) < arr(x - 1, 1) Then
        valley = arr(x, 1)
        newPeak = False
        newValley = True
    End If




Next x
finish:
PEAKS = pval


Exit Function


calc:
If (peak - valley) / peak > pval Then pval = (peak - valley) / peak
peak = 0
valley = 500
    
GoTo upnext:




End Function

Made one more edit. Darn not checking my code ever before I post it. Ya know what....one of them will work. I can't figure out what the little issue is and it's probably not even an issue in the real world.