Re-entrant function

[LesHurley]

Several weeks ago I posted a version of this and I thought I had it solved
with help from this DG - but not so!

xx(j,k) calculates the crossproduct of two 3-dimensional vectors. the
result is returned in either a row or column on the work sheet as selected by
the user. Normally the function works ok. It even works ok in
"=xx(xx(i,j),xx(k,l)) when the selection is a row but crashes at line 9, on
the third pass (Va and Vb are then Variants) when the selection is a column.
I'm using Option Base 1.

Function XX(Va, Vb)
Debug.Print TypeName(Va), TypeName(Vb)
Static r As Integer, c As Integer

r = Selection.Rows.Count
c = Selection.Columns.Count

Dim CP() As Double
If r > c Then
ReDim CP(3, 1)
8 MsgBox "Got to line 8 OK"
9 CP(1, 1) = Va(2) * Vb(3) - Va(3) * Vb(2)
10 MsgBox "Got to line 10 OK"
CP(2, 1) = Va(3) * Vb(1) - Va(1) * Vb(3)
CP(3, 1) = Va(1) * Vb(2) - Va(2) * Vb(1)
Debug.Print r, CP(1, 1), CP(2, 1), CP(3, 1)
Else
ReDim CP(1, 3)
11 CP(1, 1) = Va(2) * Vb(3) - Va(3) * Vb(2)
CP(1, 2) = Va(3) * Vb(1) - Va(1) * Vb(3)
CP(1, 3) = Va(1) * Vb(2) - Va(2) * Vb(1)
Debug.Print r, CP(1, 1), CP(1, 2), CP(1, 3)
End If
XX = CP
End Function

Can anyone help?

 

[Bob Phillips]

Function XX(Va, Vb)
Dim CP() As Double
Static r As Integer, c As Integer

Debug.Print TypeName(Va), TypeName(Vb)

r = Selection.Rows.Count
c = Selection.Columns.Count

If r > c Then
ReDim CP(3, 1)
Debug.Print "Got to line 8 OK"
CP(1, 1) = Va(2) * Vb(3) - Va(3) * Vb(2)
Debug.Print "Got to line 10 OK"
CP(2, 1) = Va(3) * Vb(1) - Va(1) * Vb(3)
CP(3, 1) = Va(1) * Vb(2) - Va(2) * Vb(1)
Debug.Print r, CP(1, 1), CP(2, 1), CP(3, 1)
XX = Application.Transpose(Application.Transpose(CP))
Else
ReDim CP(1, 3)
CP(1, 1) = Va(2) * Vb(3) - Va(3) * Vb(2)
CP(1, 2) = Va(3) * Vb(1) - Va(1) * Vb(3)
CP(1, 3) = Va(1) * Vb(2) - Va(2) * Vb(1)
Debug.Print r, CP(1, 1), CP(1, 2), CP(1, 3)
XX = CP
End If
End Function


--
---
HTH

Bob


(there's no email, no snail mail, but somewhere should be gmail in my addy)

 

[LesHurley]

Sorry Bob, that doesn't work any different than before. Still crashes when
it tries to make the assignment at line 9 (between the two debug.Print ...
ststements).

 

[Dana DeLouis]

May I suggest you write it as 1-Dim, and only transpose if needed.
This allows for only 1 major code to write.
The function "Transpose" is so common, I have it as a Library funtion Tr1, &
Tr2.
Again, just some ideas.

Sub Example()
Dim Va
Dim Vb
Dim CP(1 To 3)

Va = Array(1, 2, 3)
Vb = Array(4, 5, 7)

'// Lower Bound is 0.
'// Let's make it 1 for ease of use

Va = Tr2(Va)
Vb = Tr2(Vb)

CP(1) = Va(2) * Vb(3) - Va(3) * Vb(2)
CP(2) = Va(3) * Vb(1) - Va(1) * Vb(3)
CP(3) = Va(1) * Vb(2) - Va(2) * Vb(1)

If Selection.Columns.Count > 1 Then
ActiveCell.Resize(1, 3) = CP 'Horizontal
Else
ActiveCell.Resize(3, 1) = Tr1(CP) 'Verticle
End If
End Sub

Function Tr1(v)
' Transpose 1 time.
With WorksheetFunction
Tr1 = .Transpose(v)
End With
End Function

Function Tr2(v)
' Transpose 2 times.
With WorksheetFunction
Tr2 = .Transpose(.Transpose(v))
End With
End Function

 

[LesHurley]

I think I can use that Dana. Thanks.

 

[LesHurley]

Dana; I tried out your suggestion. It didn't work. Then I simplified it as
follows:
Function XX(Va, Vb)

Va = Tr2(Va)
Vb = Tr2(Vb)

For i = 1 To 3
10 Debug.Print "Inside for/next loop"
11 Debug.Print Va(i), Vb(i) ' It crashes here on the first time thru
the loop.
Next i
End Function

Back to the drawing board.
Les

 

[Bob Phillips]

Les,

I tested it and it seemed to work okay.

What is the data that is erroring?

--
---
HTH

Bob


(there's no email, no snail mail, but somewhere should be gmail in my addy)

 

[LesHurley]

Bob, Dana is using a sub and supplying the data in the procedure. Dana's Tr2
works OK with VBA arrays but not with Range Objects passed from EXCEL as
arguments. Any pair of 3-d vectors are fine for Va and Vb but they must come
from EXCEL. That's what the procedure is for. Please see my opening post
for details. Only one change there that shouldn't matter anyway: change the
Static to Dim on r and c.
Thanks for your help

 

[Bob Phillips]

As I said in my tests it worked fine, Dana's offering has nothing to do with
my questions.

I was hoping that you could supply some sample data that I could test with
so that I could see why it doesn't work for you.

--
---
HTH

Bob


(there's no email, no snail mail, but somewhere should be gmail in my addy)

 

[Dana DeLouis]

My guess is that the input ranges are either verticle, horizontal, or mixed.
In this test, I selected 3 horizontal cells, and "Array Entered" this
equation:

=Cross(A1:A3,C1:E1) (Ctrl+Shift+Enter)

Function Cross(xx, yy)
'// = = = = = = =
'// Cross Product
'// = = = = = = =

Dim x As Double
Dim y As Double
Dim CP(1 To 3)

x = xx.Value
y = yy.Value

'// Put input into 1-Dim form
If xx.Rows.Count > 1 Then
x = Tr1(x)
Else
x = Tr2(x)
End If

If yy.Rows.Count > 1 Then
y = Tr1(y)
Else
y = Tr2(y)
End If

CP(1) = x(2) * y(3) - x(3) * y(2)
CP(2) = x(3) * y(1) - x(1) * y(3)
CP(3) = x(1) * y(2) - x(2) * y(1)

If Application.Caller.Columns.Count > 1 Then
Cross = CP 'Horizontal
Else
Cross = Tr1(CP) 'Verticle
End If
End Function

 

[LesHurley]

Bob & Dana, thanks for your ongoing effort. My object is to be able to pass
any two two 3-d vectors as arguments to the function CrossProd. "Any", means
horizontal or verticle or one, either one, of each so long as they are
contiguous cells in EXCEL. Executing =CrossProd(j,k) is never a problem,
Executing =CrossProd(CrossProd(J,K),CrossProd(l,m)) works ok too provided the
cells selected for the answer are horizontal, but it crashes if the selecion
is verticle. I think it has something to do with the vectors received by the
function on the third pass are variant arrays rather than Range objects. I
have tried to convert the variant arrays to Range with no success. To answer
Bob's question specifically, just pick out any three numbers in EXCEL to fill
the 3-d vectors and the function must work to fulfill my objective, Thanks
again.

 

[Dana DeLouis]

... but it crashes if the selecion is verticle.

I selected the verticle range B5:B7 also, and Array entered this with no
problem ??

=Cross(A1:A3,C1:E1)

 

[Dana DeLouis]

Here's a modification to allow you to enter your own numbers if you wish.
I selected both a 3-Cell Verticle, or 3-Cell Horizontal area and
Array-Entered the following:

=Cross(A1:A3,{4,-7,2})

Function Cross(xx, yy)
'// = = = = = = =
'// Cross Product
'// = = = = = = =

Dim x As Variant
Dim y As Variant
Dim CP(1 To 3)

'// Put input into 1-Dim form
If TypeName(xx) = "Range" Then
x = xx.Value
If xx.Rows.Count > 1 Then
x = Tr1(x)
Else
x = Tr2(x)
End If
Else
x = xx
End If

If TypeName(yy) = "Range" Then
y = yy.Value
If yy.Rows.Count > 1 Then
y = Tr1(y)
Else
y = Tr2(y)
End If
Else
y = yy
End If

CP(1) = x(2) * y(3) - x(3) * y(2)
CP(2) = x(3) * y(1) - x(1) * y(3)
CP(3) = x(1) * y(2) - x(2) * y(1)

If Application.Caller.Columns.Count > 1 Then
Cross = CP 'Horizontal
Else
Cross = Tr1(CP) 'Verticle
End If
End Function

 

[LesHurley]

Dana; you seem to be missing one key fact that I have always specified. I
have never had any trouble with the simple formula {=xx(j,k)} regardless of
the orientation of j & K nor of the orientation of the selection for the
answer. The problem arises when the formula is re-entrant as in
{=xx(xx(i,j),xx(k,l))}. The first pass calculates xx(i,j), no problem. The
second pass calculates xx(k,l), still no problem. On the third pass it
calculates the CP of the results of the first two passes. Still no problem
if the selection for the answer is horizontal, but it crashes if the
selection is vertical. In the first two passes, Va and Vb are both Range
objects while on the third pass they are both variant objects. If you execute
my original post you will see that the Debug.Print TypeName(Va), TypeName(Vb)
statement right after the Function declaration confirms that. It's all very
mysterious to me. I tried declaring the, Function xx(Va, Vb) As Range but
that produces a Type Mismatch at the final assignment, xx=CP. I tried some
other things too to no avail.

 

[Dana DeLouis]

Hi. I think the problem is that with both the inner and outer calls to xx,
you are using "Selction" to base a decision.
The Outer xx call needs to look at the input, and not on the selection.
When the calculation is finished, then it needs to look at the selection.

r = Selection.Rows.Count
c = Selection.Columns.Count
If r > c ThenHere's my best guess.

I selected both a 3-cell verticle and 3-cell horizontal area and
array-entered this equation and got the same answer.
If this doesn't work, then I'm afraid I don't follow. Hopefully, this will
give you some ideas:

=Cross(Cross(A1:A3,B1:B3),Cross(D13,E1:E3))

Function Cross(Va, Vb)
'// = = = = = = =
'// Cross Product
'// Dana DeLouis
'// = = = = = = =

Dim x As Variant
Dim y As Variant
Dim CP(1 To 3) 'Cross Product

'// Put input into 1-Dim form
If TypeName(Va) = "Range" Then x = Va.Value Else x = Va
If ArrayDepth2(x) Then x = Tr1(x)
If ArrayDepth2(x) Then x = Tr1(x)

If TypeName(Vb) = "Range" Then y = Vb.Value Else y = Vb
If ArrayDepth2(y) Then y = Tr1(y)
If ArrayDepth2(y) Then y = Tr1(y)

CP(1) = x(2) * y(3) - x(3) * y(2)
CP(2) = x(3) * y(1) - x(1) * y(3)
CP(3) = x(1) * y(2) - x(2) * y(1)

Select Case TypeName(Application.Caller)
Case "Range"
If Application.Caller.Columns.Count > 1 Then
Cross = CP 'Horizontal
Else
Cross = Tr1(CP) 'Verticle
End If

Case "Error"
'Most likely called from vba
Cross = CP
End Select
End Function


Function ArrayDepth2(ByRef m) As Boolean
'// Just check for Array Depth of 2 only
Dim n
On Error Resume Next
n = UBound(m, 2)
ArrayDepth2 = Err.Number = 0
End Function

Note: I got the same answer as this math program:

Cross[Cross[{3, 4, 11}, {2, 8, 7}], Cross[{9, 10, 1}, {6, 5, 12}]]

{1617, 940, 6005}

I wrote this so that it would handle vba also.

I get the same answer as this vba routine:

Sub TestIt()
Dim m, a, b, c, d
a = [{3, 4, 11}]
b = [{2, 8, 7}]
c = [{9, 10, 1}]
d = [{6, 5, 12}]

m = Cross(Cross(a, b), Cross(c, d))
MsgBox Join(m, " , ")
End Sub

--
HTH :>)
Dana DeLouis

{=xx(xx(i,j),xx(k,l))}.

<snip>

 

[LesHurley]

Thanks Dana; I haven't tried it yet but if it works for you using the formula
you wrote it should work for me. You are using some properties/methods I'm
not familiar with so I will have to study it to understand it but I finally
have hope for success. I'll be back soon.
Les.
--
Thanks for your help

Hi. I think the problem is that with both the inner and outer calls to xx,
you are using "Selction" to base a decision.
The Outer xx call needs to look at the input, and not on the selection.
When the calculation is finished, then it needs to look at the selection.

r = Selection.Rows.Count
c = Selection.Columns.Count
If r > c ThenHere's my best guess.

I selected both a 3-cell verticle and 3-cell horizontal area and
array-entered this equation and got the same answer.
If this doesn't work, then I'm afraid I don't follow. Hopefully, this will
give you some ideas:

=Cross(Cross(A1:A3,B1:B3),Cross(D13,E1:E3))

Function Cross(Va, Vb)
'// = = = = = = =
'// Cross Product
'// Dana DeLouis
'// = = = = = = =

Dim x As Variant
Dim y As Variant
Dim CP(1 To 3) 'Cross Product

'// Put input into 1-Dim form
If TypeName(Va) = "Range" Then x = Va.Value Else x = Va
If ArrayDepth2(x) Then x = Tr1(x)
If ArrayDepth2(x) Then x = Tr1(x)

If TypeName(Vb) = "Range" Then y = Vb.Value Else y = Vb
If ArrayDepth2(y) Then y = Tr1(y)
If ArrayDepth2(y) Then y = Tr1(y)

CP(1) = x(2) * y(3) - x(3) * y(2)
CP(2) = x(3) * y(1) - x(1) * y(3)
CP(3) = x(1) * y(2) - x(2) * y(1)

Select Case TypeName(Application.Caller)
Case "Range"
If Application.Caller.Columns.Count > 1 Then
Cross = CP 'Horizontal
Else
Cross = Tr1(CP) 'Verticle
End If

Case "Error"
'Most likely called from vba
Cross = CP
End Select
End Function


Function ArrayDepth2(ByRef m) As Boolean
'// Just check for Array Depth of 2 only
Dim n
On Error Resume Next
n = UBound(m, 2)
ArrayDepth2 = Err.Number = 0
End Function

Note: I got the same answer as this math program:

Cross[Cross[{3, 4, 11}, {2, 8, 7}], Cross[{9, 10, 1}, {6, 5, 12}]]

{1617, 940, 6005}

I wrote this so that it would handle vba also.

I get the same answer as this vba routine:

Sub TestIt()
Dim m, a, b, c, d
a = [{3, 4, 11}]
b = [{2, 8, 7}]
c = [{9, 10, 1}]
d = [{6, 5, 12}]

m = Cross(Cross(a, b), Cross(c, d))
MsgBox Join(m, " , ")
End Sub

--
HTH :>)
Dana DeLouis

{=xx(xx(i,j),xx(k,l))}.

<snip>

 

[LesHurley]

Dana; your solution works perfectly. Thank you. But I don't understand the
calls to ArrayDepth2(m). I know it wont work in all cases without all of
them but why does it need any of them? I shall retain your credit block in
all future implimentations.