Precision in Excle VBA

[duane]

I was trying to have VBA to recurse on an assumed result, to
calculated one (I need to assume the answer to do some intermediat
calculations which ultimately end up with a final answer), in this cas
a temperature.

when I coded

recurse:
terror = tassume -tcalc
if terror <0 the terror = terror * -1
if terror <0.3 then goto done
tassume = tassume +0.5 * (tcalc - tassume)
go to recurse

the code did not recurse to within 0.5

but when I coded

recurse:
terror = (tassume *100 - tcalc*100)
if terror <0 the terror = terror * -1
if terror < 30 then goto done
tassume = (tassume*100 +0.5 * (tcalc - tassume)*100)/100
go to recurse

it worked fine

any thoughts??

 

[witek]

Did you declare your variables as double?

 

[duane]

yes i did, sorry should have added that to first post

 

[Dana DeLouis]

What kind of initial values do you have?

Sub Demo()
Dim TAssume
Dim TCalc
Dim TError

TAssume = 45
TCalc = 2

TError = Abs(TAssume - TCalc)
Do While TError >= 0.3
TAssume = TAssume + 0.5 * (TCalc - TAssume)
TError = Abs(TAssume - TCalc)
Loop
Debug.Print TAssume
End Sub

 

[Dana DeLouis]

If you would like, perhaps something along this line...

Do While TError >= 0.3
TAssume = (TAssume + TCalc) / 2
TError = Abs(TAssume - TCalc)
Debug.Print TError
Loop

We see that you variable TAssume is moved closer and closer to TCalc
until your error is <0.3.
We might be able to solve for this recurrence relationship without
looping. I was thinking something like this:
We first calculate how many loops it would take to get the error below 0.3.
Then we solve for the actual value.

Sub Demo2()
Dim TAssume
Dim TCalc
Dim n

TAssume = 13
TCalc = 2

If Abs(TAssume - TCalc) >= 0.3 Then
n = Log(20 * Abs(TAssume - TCalc) / 3) / Log(2)
n = WorksheetFunction.Ceiling(n, 1)
TAssume = ((2 ^ n - 2) * TCalc + 2 * TAssume) / 2 ^ n
End If
Debug.Print TAssume
End Sub

I hope I got that correct! :>0

Dana DeLouis

 

[duane]

Thanks for our help. Right now I as initializing all of the assume
values at 4. The actuals work out to be anywhere from +15 to -40. I
theory, the Tassume can influence the Tactual, so Tactual has to be
variable as Tassume changes. I am working with an older verion o
excel (2000 I think), and when I wrote the code, I trie
application.worksheetfunction.abs, but this did not exist, so
substituted if terror <0, then terror - terror * -1. Can I just cod
in the abs(arguement) in vba as you have

 

[Dana DeLouis]

Can I just code

in the abs(argument) in vba as you have?

Hi. Sure. It should work just fine.
One of a few techniques would be to type the letter "a" in the vba editor,
and then hit Ctrl+Space Bar.
You should see a list, with Abs listed first.

 

[duane]

Here is my entire code. It currently recurses the assumed to actual t
within 1.2 on an actual of -51.5, and generally to within 0.1 o
actuals closer to zero. I put the recursionlimit in because at on
point the macro would not stop recursing - I never figured out why so
simply limited it. Increasing the limit does not improve the results.
On about 120 rows of data, it runs in about 2 seconds.

Option Explicit
Sub Temprecurse()
Dim acttdrop As Double
Dim asstdrop(200) As Double
Dim lastrow As Integer
Dim firstrow As Integer
Dim asstemplosscol As Integer
Dim acttemplosscol As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim terror As Double
firstrow = Range("b5").Row
lastrow = Range("b5").End(xlDown).Row
asstemplosscol = Range("asssegtloss").Column
acttemplosscol = Range("segtloss").Column
j = asstemplosscol
k = acttemplosscol
' initialize assumed temperature drops to 4 f
For i = firstrow To lastrow
Cells(i, j).Value = 4
Next i
' Begin recursion routine
i = firstrow - 1
nextrow:
l = 0
i = i + 1
' quit after last row
If i > lastrow Then GoTo done
'Read in assumed and actual temperature drops
asstdrop(i) = Cells(i, j).Value
acttdrop = Cells(i, k).Value
recurse:
l = l + 1
'Calculate error of assumed vs actual
terror = Abs(asstdrop(i) * 1000 - acttdrop * 1000)
' set tolerance for assumed vs actual
If terror < 1 Then GoTo nextrow
' split the difference on assumed vs actual for new estimate
asstdrop(i) = (asstdrop(i) * 1000 + (acttdrop - asstdrop(i)) * 0.5
1000) / 1000
'limit recursion to 500 tries
If l = 500 Then GoTo nextrow Else GoTo recurse
done:
For i = 5 To lastrow
Cells(i, j).Value = asstdrop(i)
Next i
End Su

 

[Dana DeLouis]

Hi. I may be wrong, but it appears to me that:

asstdrop(i) = (asstdrop(i) * 1000 + (acttdrop - asstdrop(i)) * 0.5 *
1000) / 1000

is equal to:
asstdrop(i) = (asstdrop(i) + acttdrop)/2