how to find max running sequence 1

[alh1002]

My DB has monthly percentages. I want to compare sequential percentages and if they are negative multiple together to find max consecutive negative months.

I can do this in multiple steps in excel, by doing an if statement and making all positive values =1 and then doing another column of ifs where it compares the line above and and if less than one than multiples row with row above.

example

M1 -5%
M2 1%
M3 -4%
M4 -6%
M5 1%

want this to return (.96*.94-1)*100 which is -9.76

or in another example

M1 -10%
M2 1%
M3 -4%
M4 -6%
M5 1%

this should just return -10 as that is the most negative consecutive month

any ideas on how to do this in access/vba?

 

[SuryaF]

Not sure I understand your "(.96*.94-1)*100 which is -9.76" idea but see if you can adapt this code to calculate your function.

Function MyFunction() As Double

Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("MyTable")
MinProd = 0
CrtProd = 1
While Not rs.EOF
    If Nz(rs!PercField, 0) >= 0 Then
        If CrtProd <> 1 Then
            If MinProd > CrtProd Then MinProd = CrtProd
        End If
        CrtProd = 1
    Else
        CrtProd = -Abs(CrtProd * rs!PercField)
    End If
    rs.MoveNext
Wend

If CrtProd <> 1 Then
    If MinProd > CrtProd Then MinProd = CrtProd
End If

MyFunction = MinProd

End Function

 

[alh1002]

I changed it a bit to test

but the answer doesn't make sense to me

for example the data
percent
1.08832365210684
1.00899205638114
1.17818411583782
1.06316304589373
0.997640825063864
0.985738046552014
1.00239727437619
1.06028349738827
1.12160930620503
1.10432671400852
0.925754515406271
1.09378872810647
1.04517922256719
1.08585073791798
1.04697687030725
1.05366921665014
0.973082241054457
0.886080230160988
0.984250205741188
1.00248378692716
0.99384916453843
1.10577247504022
1.04997888027803
1.07342628909662
1.05379690579975
0.950380505644621
0.949503164168923


The modified code

Option Compare Database



Private Sub Calculate()

Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("tblDrawdowns")
MinProd = 1
CrtProd = 1
While Not rs.EOF
If Nz(rs!percent, 1) >= 1 Then
If CrtProd <> 1 Then
If MinProd > CrtProd Then MinProd = CrtProd
End If
CrtProd = 1
Else
CrtProd = -Abs(CrtProd * rs!percent)
End If
rs.MoveNext
Wend

If CrtProd <> 1 Then
If MinProd > CrtProd Then MinProd = CrtProd
End If

Debug.Print MinProd

End Sub


and I get an answer of -0.99384916453843

which not what I wanted, I wanted it to pick up

0.973082241054457*0.886080230160988*0.984250205741188

which are 3 data points less than 1 in order and yield the lowest number. which is ~ 0.848649008



what is wrong with this setup?

(note: to multiple percentages you convert them numbers like 4% = 1.04 or -4% becomes 0.96 so 4% *-4% =1.04*.96=0.9984 or in percents (1-0.9984)*100=-0.16%
hence the conversion)

 

[Golom]

Try something like this

Private Function MinimumProductSequence(x() As Double, _
                 ByRef FirstElement As Long, _
                 ByRef LastElement As Long) As Double

Dim MinSoFar                    As Double
Dim MinEndingHere               As Double
Dim I                           As Long
Dim TempFirstElement            As Long

MinSoFar = 1E+300
MinEndingHere = 1
For I = 0 To UBound(x)

    If MinEndingHere = 1 Then TempFirstElement = I
    MinEndingHere = MinEndingHere * x(I)
    If x(I) <= 1 Then
        If MinSoFar > MinEndingHere Then
            MinSoFar = MinEndingHere
            FirstElement = TempFirstElement
            LastElement = I
        End If
    Else
        MinEndingHere = 1
        TempFirstElement = I
    End If

Next

MinimumProductSequence = MinSoFar

End Function

And Call it with

Private Sub Command3_Click()
Dim x()                         As Double
Dim FirstElement                As Long
Dim LastElement                 As Long
Dim MinProduct                  As Double

x = TestData

MinProduct = MinimumProductSequence(x, FirstElement, LastElement)

MsgBox _
"First Element     = " & FirstElement & vbCrLf & _
"Last Element      = " & LastElement & vbCrLf & _
"Minimum Product   = " & Format(MinProduct, "0.000000")
End Sub

Private Function TestData() As Double()
Dim x()                         As Double
ReDim x(26)
x(0) = 1.08832365210684
x(1) = 1.00899205638114
x(2) = 1.17818411583782
x(3) = 1.06316304589373
x(4) = 0.997640825063864
x(5) = 0.985738046552014
x(6) = 1.00239727437619
x(7) = 1.06028349738827
x(8) = 1.12160930620503
x(9) = 1.10432671400852
x(10) = 0.925754515406271
x(11) = 1.09378872810647
x(12) = 1.04517922256719
x(13) = 1.08585073791798
x(14) = 1.04697687030725
x(15) = 1.05366921665014
x(16) = 0.973082241054457
x(17) = 0.886080230160988
x(18) = 0.984250205741188
x(19) = 1.00248378692716
x(20) = 0.99384916453843
x(21) = 1.10577247504022
x(22) = 1.04997888027803
x(23) = 1.07342628909662
x(24) = 1.05379690579975
x(25) = 0.950380505644621
x(26) = 0.949503164168923
TestData = x
End Function

 

[SuryaF]

Ok, now I understand. So the negative values are not actually negative, are less than 1. Your modified code is ok but change the CrtProd = -Abs(CrtProd * rs!percent) to CrtProd = CrtProd * rs!percent. That should do it.
I hope this helps.

 

[alh1002]

the change did the job, I thought I tried that and it didn't work. but must have been something else. Thanks again.