View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Chip Pearson Chip Pearson is offline
external usenet poster
 
Posts: 7,247
Default can't trap overflow error!

You need to understand how error handling works. When an error is
raised, your code goes to err_do, and VBA is running in "error
mode". No other errors can be trapped until you exit error mode
and go back in to normal mode. This is done with a Resume, Resume
Next, Exit Sub, or End Sub statement.


--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com





"Kate" wrote in message
...
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