Custom Function To Rank Two Ranges

diodorus · Oct 4th 2007

Hello,

i have a function ("function1") that takes a range as an input:

Code

function1 (a as Range) as Double

i have another function ("function2") that internally creates an array "a" that I need to be the input for function1. I tried, inside function2,:

Code

...
function1(a)
...

but of course (?) it does not work...

any help?

thanks!
diodo

RichardSchollar · Oct 4th 2007

Re: Array And Range

Depending on what function1 is doing, you need to change the argument type (eg to variant) so that you are not explicitly requiring a range data type. Since you provide little of the code details behind either function, it is difficult to provide specific advice.

Richard

diodorus · Oct 4th 2007

Re: Array And Range

Thanks for the reply and sorry for the lack of info.

this is function1:

Code

Function function1(ai As Double, a As Range) As Double


function1= Application.WorksheetFunction.Rank(ai, a, 1) + Application.WorksheetFunction.CountIf(a, ai) / 2


End Function

and this is function2

Code

Function function2(a As Range, b As Range) As Double


Dim aBis() As Double
Dim bBis() As Double


Dim aRank() As Double
Dim bRank() As Double


Dim indices() As Double


Dim i As Integer
Dim j As Integer
Dim h As Integer
Dim N As Integer
        
N = a.Rows.Count


h = 0
For i = 1 To N
    If (a.Offset(i - 1, 0).Resize(1, 1).Value <> "" And b.Offset(i - 1, 0).Resize(1, 1).Value <> "") Then
        h = h + 1
    End If
Next


ReDim aBis(1 To h)
ReDim bBis(1 To h)
ReDim aRank(1 To h)
ReDim bRank(1 To h)
ReDim indices(1 To h)


h = 0
For i = 1 To N
    If (a.Offset(i - 1, 0).Resize(1, 1).Value <> "" And b.Offset(i - 1, 0).Resize(1, 1).Value <> "") Then
        h = h + 1
        indices(h) = i
        aBis(h) = a.Offset(i - 1, 0).Resize(1, 1).Value
        bBis(h) = b.Offset(i - 1, 0).Resize(1, 1).Value
    End If
Next


For i = 1 To h
        j = indices(i)
        aRank(i) = function1(aBis(j), aBis)
        bRank(j) = function1(bBis(j), bBis)
Next


function2 = Application.WorksheetFunction.Correl(aRank, bRank)


End Function

Display More

The error comes when i call function1...

Thanks,
Diodo

p45cal · Oct 4th 2007

Re: Array And Range

At first glance I would do as Parsnip suggests which I think is change:

Code

Function function1( ai As Double, a As  Range) As Double

to

Code

Function function1( ai As Double, a As  Variant) As Double

p45cal

diodorus · Oct 4th 2007

Re: Array And Range

Thanks. I already tried that... I don't get the "Compile error: ByRef argument type mismatch" anymore, but I get a "#value" error in the cell.

any other ideas?

thanks,
diodo

RichardSchollar · Oct 4th 2007

Re: Array And Range

Your problem is that if a isn't a range then your call to the WorksheetFunction in Function1 will fail (Countif/Sumif only accept range arguments, and not arrays). Could you explain what your function is actually doing on your spreadsheet? Is there a need to use UDFs?

Richard

shg · Oct 4th 2007

Re: Array And Range

Parsnip may well be able to help with a non-VBA solution (or a VBA solution, for that matter).

This construct:

Code

a.Offset(i - 1, 0).Resize(1, 1).Value

... can be replaced with:

Code

a(i,1).Value

**mikerickson** · Oct 4th 2007

Re: Array And Range

Try declaring the range/array variant argument ByVal

Code

Function function1( ai As Double, ByVal a As  Variant) As Double

diodorus · Oct 4th 2007

Re: Array And Range

Quote from Parsnip

Could you explain what your function is actually doing on your spreadsheet? Is there a need to use UDFs?

Richard

ok: function1 calculates the rank of an element of a vector (the native excel function "rank" does not treat ties properly, that's why i need to define that UDF). i made a small mistake in function1. it should be:

Code

Function function1(ai As Double, a As Range) As Double
     
    function1 = Application.WorksheetFunction.Rank(ai, a, 1) + (Application.WorksheetFunction.CountIf(a, ai) - 1) / 2
     
End Function

function2 calculates the rank correlation of two vectors, where some elements of the vectors may be empty.

here is how i thought it should work. for example:

a=[ 1,"", 2,"", 3, 4]
b=[ 1, 2,"","", 4, 1]

then i create

aBis=[ 1, 3, 4]
bBis=[ 1, 4, 1]

and then i calculate

aRank=[1,2,3]
bRank=[1.5,3,1.5]

and finally

correlation(aRank,bRank).

mikerickson: I tried and did not help...

Thanks!
diodo

**Reafidy** · Oct 4th 2007

Re: Array And Range

Rank(Arg1 As Double, Arg2 As Range, [Arg3]) As Double

I dont really understand what you are trying to do but rank does not accept an array see above, it needs a range like countif does as well. Match however will accept an array so at a guess because I dont understand what you are doing if the elements were sorted you could use match to determine the position.

If you want to use rank then I think you will have to transfer the array to the worksheet first.

shg · Oct 5th 2007

Re: Rank Two Ranges

Try this. In the pleasant case that it works, I'll be happy to explain anything you wish.

Please note that it deletes partially blank rows in the input range, so COPY the data there.

Code

Sub Test()
    Debug.Print RankCorrel(Range("A2:B7"))
End Sub


Function RankCorrel(r As Range) As Variant
    ' Returns the rank correlation of the column vectors in
    ' the two-column range r
    ' Deletes rows (within the range) where blanks appear in either vector
    ' Requires use of the two columns to the right of range r
    
    ' WILL NOT WORK as a worksheet function!
    
    Dim n As Long, i As Long
    Dim sAdrs1 As String, sAdrs2 As String
    
    If r.Columns.Count <> 2 Then
        RankCorrel = "RANGE!"
        Exit Function
    End If


    n = r.Rows.Count
    For i = n To 1 Step -1
        If IsEmpty(r(i, 1)) Or IsEmpty(r(i, 2)) Then r.Rows(i).Delete shift:=xlUp
    Next i
    
    sAdrs1 = r(1).Address(False, False)
    sAdrs2 = r.Columns(1).Address(True, False)
    
    r.Offset(, 2).Formula = "=RANK(" & sAdrs1 & ", " & sAdrs2 & ", 1)" _
                    & " + (COUNTIF(" & sAdrs2 & ", " & sAdrs1 & ") - 1) / 2"
    With r.Resize(, 1)
        RankCorrel = Application.WorksheetFunction.Correl(.Offset(, 2), .Offset(, 3))
    End With
End Function

Display More

diodorus · Oct 5th 2007

Re: Custom Function To Rank Two Ranges

ok, i managed!

Code

Function rankCorrel(a As Range, b As Range) As Double
     
    Dim aBis() As Double
    Dim bBis() As Double
     
    Dim aRank() As Double
    Dim bRank() As Double
     
    Dim i As Integer
    Dim j As Integer
    Dim h As Integer
    Dim N As Integer
     
    N = a.Rows.Count
     
    h = 0
    For i = 1 To N
        If (a(i, 1).Value <> "" And b(i, 1).Value <> "") Then
            h = h + 1
        End If
    Next
     
    ReDim aBis(1 To h)
    ReDim bBis(1 To h)
    ReDim aRank(1 To h)
    ReDim bRank(1 To h)
    ReDim indices(1 To h)
     
    h = 0
    For i = 1 To N
        If (a(i, 1).Value <> "" And b(i, 1).Value <> "") Then
            h = h + 1
            aBis(h) = a(i, 1).Value
            bBis(h) = b(i, 1).Value
        End If
    Next
     
    For i = 1 To h
        aRank(i) = realRank(aBis(i), aBis, h)
        bRank(i) = realRank(bBis(i), bBis, h)
    Next
     
    rankCorrel = Application.WorksheetFunction.Correl(aRank, bRank)
     
End Function




Function realRank(ai As Double, a() As Double, h As Integer) As Double
     
Dim bigger As Integer
Dim tie As Integer
     
    bigger = 0
    tie = 0
    For i = 1 To h
        If ai > a(i) Then
            bigger = bigger + 1
            ElseIf ai = a(i) Then
                tie = tie + 1
        End If
    Next i
    realRank = 1 + bigger + (tie - 1) / 2
End Function

Display More

[hr]*[/hr] Auto Merged Post;[dl]*[/dl]thanks everyone for the help!

**Reafidy** · Oct 5th 2007

Re: Custom Function To Rank Two Ranges

Did you have a good look at SHG's example? It looks pretty good to me!!!

shg · Oct 6th 2007

Re: Custom Function To Rank Two Ranges

doidorus,

If you'd like to provide a meaningful test vector, I'd be pleased to compare my results with yours.

diodorus · Oct 6th 2007

Re: Custom Function To Rank Two Ranges

Quote from shg

doidorus,

If you'd like to provide a meaningful test vector, I'd be pleased to compare my results with yours.

great, thanks. try this (see attachment). I get 55.722451780%

I will have to calculate rank correls between any pairs of many very big vectors: to me your solution looks slower (I didn't want to go back to excel and write into a worksheet), but please correct me if i'm wrong.

Diodo

shg · Oct 7th 2007

Re: Custom Function To Rank Two Ranges

Both routines gave the same result, but ... ahem ... [SIZE="1"][COLOR="Silver"]your routine is over 10 times faster than mine[/COLOR][/SIZE] ... :oops: ... :crying:

diodorus · Oct 7th 2007

Re: Custom Function To Rank Two Ranges

ehehe... actually i now have another problem

my vectors are 56000 long. for vector until 30000 it works, but for bigger ones i get #VALUE. is there a limit to the VBA array size? can that be the cause??

ps: how do you check the speed of a procedure?

thanks!

RichardSchollar · Oct 7th 2007

Re: Custom Function To Rank Two Ranges

Sounds like an overflow error (without going into it any deeper) - I see you have some variables defined as an integer - change all of these to Longs (integers have a max value of 32,767 in VBA).

Richard

diodorus · Oct 7th 2007

Re: Custom Function To Rank Two Ranges

thanks for the tip. i changed that... but still #VALUE error...
:crying:

any other idea?

RichardSchollar · Oct 7th 2007

Re: Custom Function To Rank Two Ranges

Did you change every instance of integer or only some of them?

Custom Function To Rank Two Ranges

Participate now!

Share