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


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…



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


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