Home > Excel, UDF > How Excel solves all my problems

How Excel solves all my problems

May 17th, 2011 admin

May 8th, 2008

Last week I was on holliday and we had to divide 3 bottles of wine among ten friends.
We could have written our names on little papers and draw 3 names from the lot,
but why do something like that when you have a computer with excel.
So I wrote a array function that returns a permutation from a set of data.

I put the 10 names in A1:A10 and then selected C1:C3 and inserted =PERMUTATION(A1:A10)
finally I pressed shift ctrl enter

and voila ( sorry for the french ) a random permutation of 3 names…….

the source for this small miracle is below

Function PERMUTATION(ByRef rSource As Range) As Variant

   Dim PermCol As Collection: Dim Cell As Range: Dim Result() As Variant
   Dim iIndex As Long: Dim i As Long: Dim j As Long

   ReDim Result(1 To Application.Caller.Rows.Count, 1 To Application.Caller.Columns.Count)

   Set PermCol = New Collection

   i = 1

   For Each Cell In rSource

      PermCol.Add CStr(Trim(Cell.Value)), CStr(i): i = i + 1

   Next Cell

   For i = 1 To Application.Caller.Rows.Count

      For j = 1 To Application.Caller.Columns.Count

         iIndex = WorksheetFunction.RandBetween(1, PermCol.Count)
         Result(i, j) = PermCol(iIndex)
         PermCol.Remove (iIndex)

      Next j

   Next i

   PERMUTATION = Result

End Function

I don’t know any real life use for this function besides the dividing of winebotles I told you about.
But if somebody has any use for this beautiful function please let me know…

cheers

Jelle-Jeroen

link to this post on the excel user group with comments and other solution

 

Categories: Excel, UDF Tags: ,
Comments are closed.