Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations derfloh on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

run program

Status
Not open for further replies.

ersatz

Programmer
Oct 29, 2002
114
US
Hi,
I have a form with a button. When I click the button the program must make some calculation. My program run but it never stops. To stop it, I use ctrl+alt+delete. When I open my program I find my data but not all data. I don’t find the last 50 values.
Any idea?
Many thanks in advance.
 
Your code gets into an infinite loop somehow. Maybe if you post some code we'll be able to help.
Rob
[flowerface]
 
Thanks very much,Rob.
This is my code that gives me many headaches.


Option Compare Database
Option Explicit
Function cdf(x) As Double
Dim d As Double
Dim a As Double
Dim B As Double
Dim C As Double

d = 1 / (1 + 0.33267 * Abs(x))
a = 0.4361836
B = -0.1201676
C = 0.937298
cdf = 1 - 1 / sqr(2 * 3.1415926) * EXP(-0.5 * x ^ 2) * (a * d + B * d ^ 2 + C * d ^ 3)
If x < 0 Then cdf = 1 - cdf
End Function

Function IVC(ByVal x1 As Double, x2 As Double, x3 As Double, x4 As Double, x5 As Double) As Double
Dim Vol As Variant
Dim dv As Double
Dim d1 As Double
Dim d2 As Double
Dim perror As Double
Dim vega As Double
Dim err As Double

Vol = 0.9
err = 0.00001
dv = err + 1
While Abs(dv) > err
If x2 = 0 Or x4 = 0 Then
Exit Function
End If
If Abs(Vol) >= 300 Then
Vol = 300
End If

d1 = (Log(x4 / x2) + x5 + 0.5 * Vol ^ 2 * x3) / (Vol * sqr(x3))
d2 = d1 - Vol * sqr(x3)
perror = x4 * cdf(d1) - x2 * EXP(-x5 * x3) * cdf(d2) - x1
perror = perror
vega = x4 * sqr(x3 / 3.1415926 / 2) * EXP(-0.5 * d1 ^ 2)
If Abs(vega) < 1E-300 Then
Exit Function
End If

dv = perror / vega
Vol = Vol - dv
Wend
IVC = Vol
End Function

Private Sub Command0_Click()

Dim db1 As Database
Set db1 = CurrentDb
Dim r0 As Recordset, r1 As Recordset
Dim b2, c2, strk, strk1
strk = Array(800, 825, 850, 860, 875, 880, 900, 910, 925, 935, 950, 975)
strk1 = Array(150, 200)
Dim t As Double
Dim W As Double
Dim SQL0, sql1
Dim i, j As Integer, a As Integer
Dim bd2 As Double, ak2 As Double, bd5 As Double, ak5 As Double, IR As Double
Dim l2, m2, arrayName2, minVal2 As Double
Dim a2 As Double

SQL0 = &quot;SELECT * from DECEMBRE order by Date&quot;
Set r0 = db1.OpenRecordset(SQL0, dbOpenDynaset)
r0.MoveLast
r0.MoveFirst
While Not r0.EOF

t = r0(&quot;Ech&quot;)
W = r0(&quot;US&quot;) / 100
IR = r0.(&quot;IR L&quot;)
ReDim arrayName2(2)

'i'm looking for min value

arrayName2 = Array(Abs(IR / strk1(0) - 1), Abs(IR / strk1(1) - 1))
minVal2 = arrayName2(0)
If arrayName2(0) < arrayName2(1) Then
minVal2 = arrayName2(0)
j = 0
Else
minVal2 = arrayName2(1)
j = 1
End If
a2 = strk1(j)
b2 = &quot;IR&quot; & a2 & &quot;L&quot; & &quot; &quot; & &quot;BD&quot;
c2 = &quot;IR&quot; & a2 & &quot;L&quot; & &quot; &quot; & &quot;AK&quot;
bd2 = r0(b2)
ak2 = r0(c2)
l2 = &quot;IR&quot; & a2 & &quot;X&quot; & &quot; &quot; & &quot;BD&quot;
m2 = &quot;IR&quot; & a2 & &quot;X&quot; & &quot; &quot; & &quot;AK&quot;
bd5 = r0(l2)
ak5 = r0(m2)

Dim l0, m0, b0, c0, arrayName0, minVal0 As Double
Dim a0 As Double
Dim SP As Double
Dim ak0 As Double, ak3 As Double
Dim bd0 As Double, bd3 As Double

SP = r0.Fields(&quot;SP LST&quot;)
ReDim arrayName0(12)

'i'm looking for min value

arrayName0 = Array(Abs(SP / strk(0) - 1), Abs(SP / strk(1) - 1), Abs(SP / strk(2) - 1), Abs(SP / strk(3) - 1), Abs(SP / strk(4) - 1), Abs(SP / strk(5) - 1), Abs(SP / strk(6) - 1), Abs(SP / strk(7) - 1), Abs(SP / strk(8) - 1), Abs(SP / strk(9) - 1), Abs(SP / strk(10) - 1), Abs(SP / strk(11) - 1))
minVal0 = arrayName0(0)
For i = 0 To UBound(arrayName0)
If arrayName0(i) < minVal0 Then
minVal0 = arrayName0(i)
a = i
Else
End If
Next i
j = a
a0 = strk(j)
b0 = &quot;SP&quot; & a0 & &quot;L&quot; & &quot; &quot; & &quot;BD&quot;
c0 = &quot;SP&quot; & a0 & &quot;L&quot; & &quot; &quot; & &quot;AK&quot;
bd0 = r0(b0)
ak0 = r0(c0)
l0 = &quot;SP&quot; & a0 & &quot;X&quot; & &quot; &quot; & &quot;BD&quot;
m0 = &quot;SP&quot; & a0 & &quot;X&quot; & &quot; &quot; & &quot;AK&quot;
bd3 = r0(l0)
ak3 = r0(m0)

Dim l1, m1, b1, c1, arrayName1, minVal1 As Double
Dim a1 As Double
Dim SPX As Double
Dim bd1 As Double, bd4 As Double
Dim ak1 As Double, ak4 As Double
SX = r0(&quot;SX L&quot;)
ReDim arrayName1(12)

'i'm looking for min value

arrayName1 = Array(Abs(SX / strk(0) - 1), Abs(SX / strk(1) - 1), Abs(SX / strk(2) - 1), Abs(SX / strk(3) - 1), Abs(SX / strk(4) - 1), Abs(SX / strk(5) - 1), Abs(SX / strk(6) - 1), Abs(SX / strk(7) - 1), Abs(SX / strk(8) - 1), Abs(SX / strk(9) - 1), Abs(SX / strk(10) - 1), Abs(SX / strk(11) - 1))
minVal1 = arrayName1(0)
For i = 0 To UBound(arrayName1)
If arrayName1(i) < minVal1 Then
minVal1 = arrayName1(i)
a = i
Else
End If
Next i
j = a
a1 = strk(j)
b1 = &quot;SX&quot; & a1 & &quot;L&quot; & &quot; &quot; & &quot;BD&quot;
c1 = &quot;SX&quot; & a1 & &quot;L&quot; & &quot; &quot; & &quot;AK&quot;
bd1 = r0(b1)
ak1 = r0(c1)
l1 = &quot;SX&quot; & a1 & &quot;X&quot; & &quot; &quot; & &quot;BD&quot;
m1 = &quot;SX&quot; & a1 & &quot;X&quot; & &quot; &quot; & &quot;AK&quot;
bd4 = r0(l1)
ak4 = r0(m1)

sql1 = &quot;SELECT * from AT_dec order by Date&quot;
Set r1 = db1.OpenRecordset(sql1, dbOpenDynaset)

r1.AddNew

r1.Fields(&quot;Date&quot;) = r0(&quot;Date&quot;)
r1.Fields(&quot;Ech&quot;) = t
r1.Fields(&quot;Ft&quot;) = SP
r1.Fields(&quot;STR_F&quot;) = a0
r1.Fields(&quot;FC_BID&quot;) = bd0
r1.Fields(&quot;FC_ASK&quot;) = ak0
r1.Fields(&quot;FP_BID&quot;) = bd3
r1.Fields(&quot;FP_ASK&quot;) = ak3

r1.Fields(&quot;SX&quot;) = SX
r1.Fields(&quot;STR_SX&quot;) = a1
r1.Fields(&quot;SXC_BD&quot;) = bd1
r1.Fields(&quot;SXC_AK&quot;) = ak1
r1.Fields(&quot;SXP_BD&quot;) = bd4
r1.Fields(&quot;SXP_AK&quot;) = ak4

r1.Fields(&quot;IR&quot;) = IR
r1.Fields(&quot;STR_IR&quot;) = a2
r1.Fields(&quot;IRC_BD&quot;) = bd2
r1.Fields(&quot;IRC_AK&quot;) = ak2
r1.Fields(&quot;IRP_BD&quot;) = bd5
r1.Fields(&quot;IRP_AK&quot;) = ak5
r1.Fields(&quot;YD1&quot;) = W
r1.Fields(&quot;V_FC_BD&quot;) = IVC(bd0, a0, t, SP, W)
r1.Fields(&quot;V_FC_AK&quot;) = IVC(ak0, a0, t, SP, W)
r1.Fields(&quot;V_FP_BD&quot;) = IVC(bd3, a0, t, SP, W)
r1.Fields(&quot;V_FP_AK&quot;) = IVC(ak3, a0, t, SP, W)
r1.Fields(&quot;V_SPC_BD&quot;) = IVC(bd1, a1, t, SX, W)
r1.Fields(&quot;V_SPC_AK&quot;) = IVC(ak1, a1, t, SX, W)
r1.Fields(&quot;V_SPP_BD&quot;) = IVC(bd4, a1, t, SX, W)
r1.Fields(&quot;V_SPP_AK&quot;) = IVC(ak4, a1, t, SX, W)
r1.Update
r0.MoveNext
Wend

r0.Close
r1.Close
Dim rst As Recordset
Dim strSQL As String
Dim CurrValue As Double
Dim PrevValue As Double
Dim VarRelat As Double
strSQL = &quot;Select * from AT_dec ORDER BY Date&quot;
Set rst = db1.OpenRecordset(strSQL, dbOpenDynaset)

rst.MoveFirst
CurrValue = 0
PrevValue = 100 - rst(&quot;YLD1&quot;)
rst.MoveNext
While Not rst.EOF
CurrValue = 100 - rst(&quot;YLD1&quot;)
VarRelat = (CurrValue / PrevValue) - 1
PrevValue = CurrValue
rst.Edit
rst(&quot;VAR_RELAT&quot;) = VarRelat
rst.Update
rst.MoveNext
Wend
rst.Close
db1.Close
End Sub
 
Without delving too deep, it would appear that the problem is most likely in your IVC function. If the do..loop structure gets into an infinite loop, with no I/O commands in between, it can really hang up. I'd recommend putting a temporary I/O statement inside that loop (even just printing to the debug window), which will allow the ctrl-Break key combination to interrupt the execution. Then you can troubleshoot in debug mode.
Does that make sense?
Rob
[flowerface]
 
Hi Rob,
I'm a beginner of access VBA, I learn myself and I have many difficulties with debug mode.
What do you mean with temporary I/O?
 
Inside your do...while loop within IVC, put the statement

debug.print dv,

this will print the value of dv to VBE's immediate window, which will allow you to break the code execution by hitting Ctrl-Break, and also will show you if dv is ever getting below the value of err. By the way, don't use err as a variable name (that may be your problem, actually) - it's a defined word within VBA. Rename it to perhaps errr, and see what happens.
Rob
[flowerface]
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top