Code help

bknight
BronzeLounger
Posts: 1402
Joined: 08 Jul 2016, 18:53

Code help

Post by bknight »

I've had a code that quit functioning properly yesterday. I have rearranged it but get an error message: Next without a For.

Code: Select all

Sub CalcTUProfit(Profit)
'This Function Will Calculate The Profit for TU Only
Dim db As DAO.Database
Dim Rs As DAO.Recordset
Dim Fld1 As Field, Fld2 As Field, Fld3 As Field
Dim Fld4 As Field, Fld5 As Field, Fld6 As Field
Dim Fld7 As Field, Fld11 As Field, Fld12 As Field
Dim I As Long, J As Long, CountTicks As Long, intCurQty As Integer, intnextQty As Integer, intbackRec As Integer
Dim intCurWhle As Integer, intPrevWhle As Integer, intWhleMult As Integer
Dim dblPrevAmt As Double, dblCurAmt As Double, dblPrevFrc As Double, dblCurFrc As Double, dblBuyP As Double, dblSellP As Double
Dim dblCurCom As Double, dblCurFee As Double, dblPrevCom As Double, dblPrevFee As Double
Dim strCurSymbol As String, strCurCon As String, strCurRawP As String, strPrevRawP As String
Dim varStart As Variant, varEnd As Variant
Dim p As Double, p1 As Double
Set db = CurrentDb
Set Rs = db.OpenRecordset("Select * From Trades Order By ID")
Set Fld1 = Rs!ID
Set Fld2 = Rs!Tradedate
Set Fld3 = Rs!Symbol
Set Fld4 = Rs!ContractMonth
Set Fld5 = Rs!Quantity
Set Fld6 = Rs!ActionID
Set Fld7 = Rs!RawP
Set Fld11 = Rs!Amount
Set Fld12 = Rs!Profit
Rs.MoveFirst
Rs.MoveLast
    strCurSymbol = Fld3
    strCurCon = Fld4
    intCurQty = Fld5
    strCurRawP = Fld7 'Closing Price of TU
    dblCurCom = -Abs(Fld5 * 1.5)
    dblCurFee = -Abs(Fld5 * 0.67)
    p = InStr(strCurRawP, "'")
    intCurWhle = Left(strCurRawP, p - 1)
    dblCurFrc = Mid(strCurRawP, p + 1)
        If Fld6 = 46 Or Fld6 = 47 Then
            dblBuyP = intCurWhle + dblCurFrc / 32
        Else
            dblSellP = intCurWhle + dblCurFrc / 32
        End If 'If Fld6 = 46 Or Fld6 = 47 Then
For I = Rs.RecordCount To 2 Step -1
    If I < Rs.RecordCount Then
        If Fld6 = 46 Or Fld6 = 48 Then
        'Find prev opening trades
            If Fld3 = strCurSymbol And Fld4 = strCurCon And IsNull(Fld12) Then 'If multiple openings, then place a zero in profit of closed opening trade
            'Found prev opening symbol and contract
                dblPrevCom = -Abs(Fld5 * 1.5)
                dblPrevFee = -Abs(Fld5 * 0.67)
                varEnd = dblCurFrc
                strPrevRawP = Fld7
                p = InStr(strPrevRawP, "'")
                intPrevWhle = Left(strPrevRawP, p - 1)
                dblPrevFrc = Mid(strPrevRawP, p + 1)
                    If Fld6 = 46 Or Fld6 = 47 Then
                        dblBuyP = intPrevWhle + dblPrevFrc / 32
                    Else
                        dblSellP = intPrevWhle + dblPrevFrc / 32
                    End If 'If Fld6 = 46 Or Fld6 = 47 Then
                varStart = dblPrevFrc 'Example 102+02.1
                'Count the number of ticks between Start and End
                'For each whole number there are 256 ticks
                varEnd = Abs(intPrevWhle - intCurWhle) * 256 + dblCurFrc
                    If varStart <= varEnd Then
                        For J = 10 * varStart + 1 To 10 * varEnd
                            If J Mod 10 <> 4 And J Mod 10 <> 9 Then
                                CountTicks = CountTicks + 1
                            End If 'If J Mod 10 <> 4 And J Mod 10 <> 9 Then
                        Next J
                    Else
                        For J = 10 * varStart - 1 To 10 * varEnd Step -1
                            If J Mod 10 <> 4 And J Mod 10 <> 9 Then
                                CountTicks = CountTicks + 1
                            End If
                        Next J
                    End If 'If varStart <= varEnd Then
                Rs.MoveLast ' move to the closing trade
                Rs.Edit
                    If dblSellP > dblBuyP Then
                        Fld12 = Abs(Fld5) * CountTicks * 7.8125 - Abs(Fld5 * 1.5) - Abs(Fld5 * 0.67) - Abs(dblPrevCom) - Abs(dblPrevFee)
                    Else
                        Fld12 = -Abs(Fld5) * CountTicks * 7.8125 - Abs(Fld5) * 1.5 - Abs(Fld5 * 0.67) - Abs(dblPrevCom) - Abs(dblPrevFee)
                    End If 'If dblSellP > dblBuyP Then
                Rs.Update
                Exit For
            End 'If Fld3 = strCurSymbol And Fld4 = strCurCon And IsNull(Fld12) Then 'If multiple openings, then place a zero in profit of closed opening trade
        End 'Fld6 = 46 Or Fld6 = 48 Then
    End If 'If I < Rs.RecordCount Then
Rs.MovePrevious
Next I
Set Rs = Nothing
Set db = Nothing
End Sub
s you can see there is a For in the code but some of the intervening code has ended it and the third from the last statement is "extraneous" I have included comments on the If statements in an attempt to debug. I think I have ended all the Ifs, but maybe not.

robertocm
Lounger
Posts: 43
Joined: 07 Jun 2023, 15:34

Re: Code help

Post by robertocm »

Both should be 'End If', not just 'End'

Code: Select all

            End 'If Fld3 = strCurSymbol And Fld4 = strCurCon And IsNull(Fld12) Then 'If multiple openings, then place a zero in profit of closed opening trade
        End 'Fld6 = 46 Or Fld6 = 48 Then
Last edited by robertocm on 12 Jul 2023, 17:23, edited 2 times in total.

bknight
BronzeLounger
Posts: 1402
Joined: 08 Jul 2016, 18:53

Re: Code help

Post by bknight »

Thanks, different than Lua.

bknight
BronzeLounger
Posts: 1402
Joined: 08 Jul 2016, 18:53

Re: Code help

Post by bknight »

After changing the code to "start" at record 9224 I get an error message "no current record" After selecting ok, all the values populate so I'm not sure where the error might. You will notice a lot of commented out lines as this is a work in progress until it runs like the old code.

Code: Select all

Sub CalculateFields(sngOSCChange)
On Error GoTo Err_Handler
'This Function Will Calculate a Group of Indexes, Not Just the Last
'Assume 01/03/2023 is correct record 9224
Dim db As Database
Dim Rs As Recordset
Dim Fld1 As Field, Fld2 As Field, Fld3 As Field
Dim Fld4 As Field, Fld5 As Field, Fld6 As Field
Dim Fld7 As Field, Fld8 As Field, Fld9 As Field
Dim Fld10 As Field, Fld11 As Field, Fld12 As Field, Fld13 As Field
Dim I As Long, NumRec As Long, PrevIndex As Long, CurDaysData As Long
Dim Prev10 As Single, Prev5 As Single, PrevOSC As Single, PrevCum As Single, PrevSum As Single, OSCCompare As Single
Dim strErrorMessage As String
Set db = CurrentDb
Set Rs = db.OpenRecordset("Select Count(*) From tblMcClellan")
NumRec = Rs(0)
Set Rs = db.OpenRecordset("Select * From tblMcClellan Order By DateIndex")
Set Fld1 = Rs!CumAdvDec
Set Fld2 = Rs!TradeDay
Set Fld3 = Rs!USTK
Set Fld4 = Rs!DSTK
Set Fld5 = Rs!UVOL
Set Fld6 = Rs!DVOL
Set Fld7 = Rs!TRIN
Set Fld8 = Rs!Diff
Set Fld9 = Rs!TEN_PCT
Set Fld10 = Rs!FIVE_PCT
Set Fld11 = Rs!OSC
Set Fld12 = Rs!SUM
Set Fld13 = Rs!OSCDiff
Rs.MoveLast
Rs.MoveFirst
Rs.MoveFirst
Rs.Move 9223 'Move 9223 from 1
Prev10 = Fld10
Prev5 = Fld11
PrevSum = Fld13
PrevCum = Fld1
PrevOSC = Fld11
For I = 9224 To NumRec
If IsNull(Fld3) Or IsNull(Fld4) Then
strErrorMessage = MsgBox("There must be advancing and declining stocks on " & Fld2, vbOKOnly)
Exit Sub
End If
If IsNull(Fld5) Or IsNull(Fld6) Then
strErrorMessage = MsgBox("There must be advancing and declining volume on " & Fld2, vbOKOnly)
Exit Sub
End If
'Calculates all data
'From 01/03/2023
'If Rs.AbsolutePosition <> 0 Then
If I = 9224 Then
Rs.MoveNext
End If
    If IsNull(Fld7) Or IsNull(Fld8) Or IsNull(Fld9) Or IsNull(Fld10) Or IsNull(Fld11) Or IsNull(Fld12) Or IsNull(Fld13) Then
    Rs.Edit
    'Prev10 = Fld9
    'Prev5 = Fld10
    'PrevOSC = Fld11
    'PrevSum = Fld12
    'PrevCum = Fld1
'CLng Conversion Rounds to the Nearest Even Number
    Fld7 = (CLng(10000 * (Fld3 / Fld4) / (Fld5 / Fld6))) / 10000
    Fld8 = Fld3 - Fld4
    Fld1 = Fld8 + PrevCum
'Old Method Of Calculating 10% And 5%
'Fld9 = CInt(Prev10 + (0.1 * (Fld3 - Fld4 - Prev10)))
'Fld10 = CInt(Prev5 + (0.05 * (Fld3 - Fld4 - Prev5)))
'Ratio Adjusted Oscillator Calculation
'Advances Minus Delines, The Result Divided By Advances Plus Declines
'Multiplication By 1000 Allows The Result To Be A Whole Number
'CurDaysData = 1000 * (Fld3 - Fld4) / (Fld3 + Fld4)
    Fld9 = Prev10 + (0.1 * (Fld3 - Fld4 - Prev10))
    Fld10 = Prev5 + (0.05 * (Fld3 - Fld4 - Prev5))
    Fld11 = Fld9 - Fld10
    OSCCompare = Fld11 - PrevOSC
    Fld13 = OSCCompare
'Old Method Of Summation Calculation
'Fld12 = Fld11 + PrevOSC
'One method Of Calculating Index
'Fld12 = 1000 - (9 * Fld9) + (19 * Fld10)
    Fld12 = Fld11 + PrevSum
    Rs.Update
    End If 'If IsNull(Fld7) Or IsNull(Fld8) Or IsNull(Fld9) Or IsNull(Fld10) Or IsNull(Fld11) Or IsNull(Fld12) Or IsNull(Fld13) Then
Prev10 = Fld9
Prev5 = Fld10
PrevOSC = Fld11
PrevSum = Fld12
PrevCum = Fld1
'Else
'End If 'If I <= 9224 Then
Rs.MoveNext
Next I
sngOSCChange = OSCCompare
Set Rs = Nothing
Set db = Nothing
Exit_Handler:
Exit Sub


User avatar
HansV
Administrator
Posts: 78568
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Code help

Post by HansV »

You have two Rs.MoveNext lines in the loop. the first is executed just once, but in combination with the other one it will still cause the recordset to move past the end.
You might replace

If I = 9224 Then
Rs.MoveNext
End If

with

Rs.MoveNext

and remove the second Rs.MoveNext
Best wishes,
Hans

User avatar
HansV
Administrator
Posts: 78568
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Code help

Post by HansV »

Or replace the For Next loop with

Code: Select all

    Do While Not Rs.EOF
        Rs.MoveNext
        ...
        ...
    Loop
Best wishes,
Hans

bknight
BronzeLounger
Posts: 1402
Joined: 08 Jul 2016, 18:53

Re: Code help

Post by bknight »

HansV wrote:
02 Oct 2023, 20:57
Or replace the For Next loop with

Code: Select all

    Do While Not Rs.EOF
        Rs.MoveNext
        ...
        ...
    Loop
That seems like the best way to fix it, I'll give it a try later on tonight, when fresh data is poster.

bknight
BronzeLounger
Posts: 1402
Joined: 08 Jul 2016, 18:53

Re: Code help

Post by bknight »

Are you thinking that the do loop should be after

Code: Select all

If I = 9224 Then
Rs.MoveNext
End If
or replace the

Code: Select all

For I = 9224 To NumRec
??

User avatar
HansV
Administrator
Posts: 78568
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Code help

Post by HansV »

Exactly what I wrote: replace the For Next loop, i.e.

Code: Select all

For I = 9224 To NumRec
becomes

Code: Select all

    Do While Not Rs.EOF
        Rs.MoveNext
Remove

Code: Select all

If I = 9224 Then
Rs.MoveNext
End If
and

Code: Select all

Rs.MoveNext
The line

Code: Select all

Next I
becomes

Code: Select all

    Loop
Best wishes,
Hans

bknight
BronzeLounger
Posts: 1402
Joined: 08 Jul 2016, 18:53

Re: Code help

Post by bknight »

remove

Code: Select all

If I = 9224 Then
Rs.MoveNext
End If
That won't work as the code will calculate the data for record 9224, but I want to use the data from the calculated fields in 9224 to remain unchanged

Code: Select all

Prev5 = Fld11
PrevSum = Fld13
PrevCum = Fld1
PrevOSC = Fld11
then move to the next record to do the calculations on 9225>>end of my time on earth. You may notice that these same lines exist just prior to Rs.MoveNext (the second one) .
My intention is to use those calculated fields as variables for the next record.

bknight
BronzeLounger
Posts: 1402
Joined: 08 Jul 2016, 18:53

Re: Code help

Post by bknight »

Ok, I switched items around a bit. Code is unchanged prior to

Code: Select all

Rs.Move 9223 'Move 9223 from 1
Prev10 = Fld10
Prev5 = Fld11
PrevSum = Fld13
PrevCum = Fld1
PrevOSC = Fld11
Rs.MoveNext
Do While Not Rs.EOF
    If IsNull(Fld3) Or IsNull(Fld4) Then
        strErrorMessage = MsgBox("There must be advancing and declining stocks on " & Fld2, vbOKOnly)
    Exit Sub
    End If
    If IsNull(Fld5) Or IsNull(Fld6) Then
        strErrorMessage = MsgBox("There must be advancing and declining volume on " & Fld2, vbOKOnly)
    Exit Sub
    End If
    If IsNull(Fld7) Or IsNull(Fld8) Or IsNull(Fld9) Or IsNull(Fld10) Or IsNull(Fld11) Or IsNull(Fld12) Or IsNull(Fld13) Then
    Rs.Edit
'CLng Conversion Rounds to the Nearest Even Number
    Fld7 = (CLng(10000 * (Fld3 / Fld4) / (Fld5 / Fld6))) / 10000
    Fld8 = Fld3 - Fld4
    Fld1 = Fld8 + PrevCum
'Old Method Of Calculating 10% And 5%
'Fld9 = CInt(Prev10 + (0.1 * (Fld3 - Fld4 - Prev10)))
'Fld10 = CInt(Prev5 + (0.05 * (Fld3 - Fld4 - Prev5)))
'Ratio Adjusted Oscillator Calculation
'Advances Minus Delines, The Result Divided By Advances Plus Declines
'Multiplication By 1000 Allows The Result To Be A Whole Number
'CurDaysData = 1000 * (Fld3 - Fld4) / (Fld3 + Fld4)
    Fld9 = Prev10 + (0.1 * (Fld3 - Fld4 - Prev10))
    Fld10 = Prev5 + (0.05 * (Fld3 - Fld4 - Prev5))
    Fld11 = Fld9 - Fld10
    OSCCompare = Fld11 - PrevOSC
    Fld13 = OSCCompare
'Old Method Of Summation Calculation
'Fld12 = Fld11 + PrevOSC
'One method Of Calculating Index
'Fld12 = 1000 - (9 * Fld9) + (19 * Fld10)
    Fld12 = Fld11 + PrevSum
    Rs.Update
    End If 'If IsNull(Fld7) Or IsNull(Fld8) Or IsNull(Fld9) Or IsNull(Fld10) Or IsNull(Fld11) Or IsNull(Fld12) Or IsNull(Fld13) Then
        Prev10 = Fld9
        Prev5 = Fld10
        PrevOSC = Fld11
        PrevSum = Fld12
        PrevCum = Fld1
Rs.MoveNext
Loop
sngOSCChange = OSCCompare
Set Rs = Nothing
Set db = Nothing
Exit_Handler:
Exit Sub

Err_Handler:
    MsgBox Err.Description
    Resume Exit_Handler
    Exit Sub
End Sub
Works and gets rid of the first Rs.MoveNext in the loop. Thanks for the suggestion.

snb
4StarLounger
Posts: 586
Joined: 14 Nov 2012, 16:06

Re: Code help

Post by snb »

If you post a sample file, I fear it can be done in 3 lines of code.

bknight
BronzeLounger
Posts: 1402
Joined: 08 Jul 2016, 18:53

Re: Code help

Post by bknight »

It is doubtful that the code wouId will be 3 steps. I will attach a spreadsheet of the data for this year from another machine.