K
Kate
Hi, I have a macro that chokes on overflow errors, even though I have
error-trapping invoked. Can anyone help me to trap these errors (they
occur when z=0, or x*x is larger than a double allows, etc.)? I've
tried various placements of the on error goto statement, but none do
the trick. Thanks for helping! This is how the entire code looks at
present:
Public Sub LS()
Dim i, j, n As Integer
Dim fk As Double, x As Double, y As Double, z As Double, p As Double,
K0 As Double
Dim xy As Double, x2 As Double, yz As Double, xz As Double
Dim Sxy As Double, Sx2 As Double, Syz As Double, Sxz As Double
Dim fk1 As Double, x1 As Double, z1 As Double, p1 As Double
Dim xy1 As Double, x12 As Double, yz1 As Double, xz1 As Double
Dim Sxy1 As Double, Sx12 As Double, Syz1 As Double, Sxz1 As Double
Dim k(1000) As Double
Dim Converged As Boolean
Dim mult As Single
Dim bDone As Boolean
'find out how many rows contain data
Sheets("Fit Data").Select
'determine number of rows containing data
Range("a10").Select
Selection.End(xlDown).Select
n = ActiveCell.Row
mult = 0.1
K0 = Range("$B$7").Value
Do Until Converged
k(1) = Range("$B$7").Value
k(0) = k(1) * 0.9
For j = 1 To 1000
Sxy = 0
Sx2 = 0
Syz = 0
Sxz = 0
Sxy1 = 0
Sx12 = 0
Syz1 = 0
Sxz1 = 0
For i = 10 To n
On Error GoTo Err_Do
'populate all variables
p = k(j) * -1 * Range("$A" & i).Value
p1 = k(j - 1) * -1 * Range("$A" & i).Value
x = 1 - Exp(p)
x1 = 1 - Exp(p1)
y = Range("$B" & i).Value
z = Range("$A" & i).Value * Exp(p)
z1 = Range("$A" & i).Value * Exp(p1)
xy = x * y
xy1 = x1 * y
x2 = x * x
x12 = x1 * x1
xz = x * z
xz1 = x1 * z1
yz = y * z
yz1 = y * z1
Sxy = xy + Sxy
Sxy1 = xy1 + Sxy1
Sx2 = x2 + Sx2
Sx12 = x12 + Sx12
Syz = yz + Syz
Syz1 = yz1 + Syz1
Sxz = xz + Sxz
Sxz1 = xz1 + Sxz1
Next i
On Error GoTo Err_Do
fk = Sxy / Sx2 - Syz / Sxz
fk1 = Sxy1 / Sx12 - Syz1 / Sxz1
k(j + 1) = k(j) - fk * (k(j) - k(j - 1)) / (fk - fk1)
If Abs((k(j + 1) - k(j)) / k(j)) < 0.00000001 Then
If k(j + 1) > 0 Then
Range("$B$7").Select
ActiveCell.Value = k(j + 1)
Range("$d$7").Select
ActiveCell.Value = Syz1 / Sxz1
Converged = True
Exit Sub
End If
End If
Next j
Err_Do:
If Not Converged Then
If bDone Then
MsgBox "Couldn't converge with a starting k of " & Round(K0
/ 10, 4) & " or " & Round(K0, 4) & " or " & Round(K0 * 10, 2)
Exit Sub
End If
'multiply original guess (K0) by 0.1, then by 10
Range("$B$7").Select
ActiveCell.Value = K0 * mult
If mult = 0.1 Then
mult = 10
Else
bDone = True
End If
End If
Loop
End Sub
error-trapping invoked. Can anyone help me to trap these errors (they
occur when z=0, or x*x is larger than a double allows, etc.)? I've
tried various placements of the on error goto statement, but none do
the trick. Thanks for helping! This is how the entire code looks at
present:
Public Sub LS()
Dim i, j, n As Integer
Dim fk As Double, x As Double, y As Double, z As Double, p As Double,
K0 As Double
Dim xy As Double, x2 As Double, yz As Double, xz As Double
Dim Sxy As Double, Sx2 As Double, Syz As Double, Sxz As Double
Dim fk1 As Double, x1 As Double, z1 As Double, p1 As Double
Dim xy1 As Double, x12 As Double, yz1 As Double, xz1 As Double
Dim Sxy1 As Double, Sx12 As Double, Syz1 As Double, Sxz1 As Double
Dim k(1000) As Double
Dim Converged As Boolean
Dim mult As Single
Dim bDone As Boolean
'find out how many rows contain data
Sheets("Fit Data").Select
'determine number of rows containing data
Range("a10").Select
Selection.End(xlDown).Select
n = ActiveCell.Row
mult = 0.1
K0 = Range("$B$7").Value
Do Until Converged
k(1) = Range("$B$7").Value
k(0) = k(1) * 0.9
For j = 1 To 1000
Sxy = 0
Sx2 = 0
Syz = 0
Sxz = 0
Sxy1 = 0
Sx12 = 0
Syz1 = 0
Sxz1 = 0
For i = 10 To n
On Error GoTo Err_Do
'populate all variables
p = k(j) * -1 * Range("$A" & i).Value
p1 = k(j - 1) * -1 * Range("$A" & i).Value
x = 1 - Exp(p)
x1 = 1 - Exp(p1)
y = Range("$B" & i).Value
z = Range("$A" & i).Value * Exp(p)
z1 = Range("$A" & i).Value * Exp(p1)
xy = x * y
xy1 = x1 * y
x2 = x * x
x12 = x1 * x1
xz = x * z
xz1 = x1 * z1
yz = y * z
yz1 = y * z1
Sxy = xy + Sxy
Sxy1 = xy1 + Sxy1
Sx2 = x2 + Sx2
Sx12 = x12 + Sx12
Syz = yz + Syz
Syz1 = yz1 + Syz1
Sxz = xz + Sxz
Sxz1 = xz1 + Sxz1
Next i
On Error GoTo Err_Do
fk = Sxy / Sx2 - Syz / Sxz
fk1 = Sxy1 / Sx12 - Syz1 / Sxz1
k(j + 1) = k(j) - fk * (k(j) - k(j - 1)) / (fk - fk1)
If Abs((k(j + 1) - k(j)) / k(j)) < 0.00000001 Then
If k(j + 1) > 0 Then
Range("$B$7").Select
ActiveCell.Value = k(j + 1)
Range("$d$7").Select
ActiveCell.Value = Syz1 / Sxz1
Converged = True
Exit Sub
End If
End If
Next j
Err_Do:
If Not Converged Then
If bDone Then
MsgBox "Couldn't converge with a starting k of " & Round(K0
/ 10, 4) & " or " & Round(K0, 4) & " or " & Round(K0 * 10, 2)
Exit Sub
End If
'multiply original guess (K0) by 0.1, then by 10
Range("$B$7").Select
ActiveCell.Value = K0 * mult
If mult = 0.1 Then
mult = 10
Else
bDone = True
End If
End If
Loop
End Sub