sjj
sjj

Reputation: 31

User defined function in VBA not working and returns zero, no data type mismatch

I'm defining a user defined function as follows, when I am trying to call it in a subroutine, it returns a "zero" value, which surely is wrong.

Function Getpartialderiv_K_x(x As Variant, y As Variant, P As Variant, 
T As Variant, hx As Variant, dx As Variant) As Variant

Dim i As Integer
ReDim dx(1 To UBound(x, 1)) As Variant

'record the original value for x
Dim original_x As Variant
original_x = x

'calc f(x+1)
For i = 1 To UBound(x, 1)
x(i) = original_x(i) + dx(i)
Next i
Dim f1 As Variant
f1 = ThermoRel(x, y, P, T)

'calc f(x-1)
For i = 1 To UBound(x, 1)
x(i) = original_x(i) - dx(i)
Next i
Dim f2 As Variant
f2 = ThermoRel(x, y, P, T)

'calc partial deriv
ReDim pderiv(1 To UBound(x, 1))
'get the results of partial derivatives
For i = 1 To UBound(x, 1)
pderiv(i) = (f1(i) - f2(i)) / (2 * hx)
Next i

Getpartialderiv_K_x = pderiv

End Function

Sub click2()

ReDim x(1 To 3) As Variant
ReDim y(1 To 3) As Variant
x = Array(0.4, 0.3, 0.3)
y = Array(0.3, 0.2, 0.5)
Dim P As Variant
P = 1171.904923  'pressure in the unit of psia
Dim T As Variant
T = 527.67 'fix temperature in the unit of oR
Dim hx As Variant
hx = 0.001
ReDim dx(1 To 3) As Variant
dx = Array(hx, 0, 0)

Dim result As Variant
result = Getpartialderiv_K_x(x, y, P, T, hx, dx)

MsgBox (result(1))

End Sub

However, when I was trying to duplicate the same code defining the above function using a subroutine, and providing the same input values, the results are totally OK, as follows:

Sub click()
Dim i As Integer
ReDim x(1 To 3) As Variant
ReDim y(1 To 3) As Variant
x = Array(0.4, 0.3, 0.3)
y = Array(0.3, 0.2, 0.5)
Dim P As Variant
P = 1171.904923  'pressure in the unit of psia
Dim T As Variant
T = 527.67 'fix temperature in the unit of oR
Dim hx As Variant
hx = 0.001
ReDim dx(1 To 3) As Variant
dx = Array(hx, 0, 0)

Dim original_x As Variant
original_x = x

'calc f(x + 1)
 For i = 1 To 3
 x(i) = original_x(i) + dx(i)
 Next i
 Dim f1 As Variant
 f1 = ThermoRel(x, y, P, T)

 'calc f(x - 1)
 For i = 1 To 3
 x(i) = original_x(i) - dx(i)
 Next i
 Dim f2 As Variant
 f2 = ThermoRel(x, y, P, T)

 ReDim pderiv(1 To 3) As Variant
 For i = 1 To 3
 pderiv(i) = (f1(i) - f2(i)) / (2 * hx)
 Next i

 Msgbox(pderiv(3))

 End Sub

I have checked the data type and it seems there is no mismatch. And also, the function ThermoRel(x, y, P, T) works fine and has a variant data type. I have spent a lot of time and tried every way I can think of but still cannot figure it out, your inputs would be highly appreciated!!!

In order for you to easily debug it, I made a virtual example with the same errors (outputs zero) as follows:

Option Explicit
Option Base 1
Function ThermoRel2(x As Variant, y As Variant, P As Variant, T As Variant) As Variant

Dim i As Integer       'component index
Dim Ke As Variant      'equilibrium constant for each component
Ke = Array(0.8789, 1.0389, 0.7903)
ReDim outvec(LBound(x, 1) To UBound(x, 1)) As Variant

For i = LBound(x, 1) To UBound(x, 1)
outvec(i) = y(i) - x(i) * Ke(i)
Next i

ThermoRel2 = outvec

End Function

Function Getpartialderiv_K_x_2(x As Variant, y As Variant, P As Variant, T  As Variant, hx As Variant, dx As Variant) As Variant

Dim i As Integer
ReDim dx(LBound(x, 1) To UBound(x, 1)) As Variant

'record the original value for x
Dim original_x As Variant
original_x = x

'calc f(x+1)
For i = LBound(x, 1) To UBound(x, 1)
x(i) = original_x(i) + dx(i)
Next i
Dim f1 As Variant
f1 = ThermoRel2(x, y, P, T)

'calc f(x-1)
For i = LBound(x, 1) To UBound(x, 1)
x(i) = original_x(i) - dx(i)
Next i
Dim f2 As Variant
f2 = ThermoRel2(x, y, P, T)

'calc partial deriv
ReDim pderiv(LBound(x, 1) To UBound(x, 1))
'get the results of partial derivatives
For i = LBound(x, 1) To UBound(x, 1)
pderiv(i) = (f1(i) - f2(i)) / (2 * hx)
Next i

Getpartialderiv_K_x_2 = pderiv

End Function

Sub dbg()

Dim x As Variant
Dim y As Variant
ReDim x(1 To 3) As Variant
ReDim y(1 To 3) As Variant
x = Array(0.4, 0.3, 0.3)
y = Array(0.3, 0.2, 0.5)
Dim P As Variant
P = 1171.904923  'pressure in the unit of psia
Dim T As Variant
T = 527.67 'fix temperature in the unit of oR
Dim hx As Variant
hx = 0.001
Dim dx As Variant
ReDim dx(1 To 3) As Variant
dx = Array(hx, 0, 0)
Dim result As Variant
result = Getpartialderiv_K_x_2(x, y, P, T, hx, dx)
MsgBox (result(1))
End Sub

Thank you all for the help! I found in the locals window that the dx array becomes all zero after the function is called, which should be (hx, 0, 0). Out of some reason, the dx array is enforced to all zero, I don't know why...

Upvotes: 0

Views: 384

Answers (1)

Tim Williams
Tim Williams

Reputation: 166790

Your problem may be your use of Array() to populate (eg) x By using that you're re-defining the bounds:

Dim x()

ReDim x(1 To 3) As Variant

Debug.Print LBound(x), UBound(x) '<< 1, 3

x = Array(0.4, 0.3, 0.3)

Debug.Print LBound(x), UBound(x) '<< 0, 2

Upvotes: 1

Related Questions