View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
John Michl John Michl is offline
external usenet poster
 
Posts: 81
Default Randomized Paired Comparison Array

Thanks for the suggestions. This is what I ended up with.
First I asked the user for number of choices and then collected the
string value for each choice and stored those in a range. (For
example: 3 choices: Vanilla, Chocolate, Strawberry)

Then, I created a table of index numbers in two columns to represent
the possible pairings. I used index numbers to represent the position
each string had in the original list (1 = Vanilla, 2 = Chocolate, 3 =
Strawberry)

Since I used index numbers instead of the strings, I was able to For -
Next statements and in If statement to ensure my list did not contain
duplicates or pairs where both items were the same.

Once the list table was created, I added a column of random numbers and
sorted.

In another procedure, I've pulled the table of index numbers in their
random order into array and the string values for the choices into
another array. With Looping and InputBox, I've been able to cycle
through the choices and record the "winner" of each pairing.

Here's the code for creating that initial table.

Thanks for the suggestions.

- John

----------------------------------------------------------------------------------------------------------

Sub SetupChoices()

Dim r As Integer ' Row index
Dim c As Integer ' Column index
Dim n As Integer ' Number of Choices
Dim d As Integer ' Data counter
Dim sh As Worksheet
Dim strChoice As String

Set sh = Worksheets("Data")
sh.Range("2:65000").Clear 'clear previous entries

' Collect the list of possible choices
n = InputBox("How many choices?")
For i = 1 To n
strChoice = InputBox("Enter choice " & i)
sh.Cells(i + 1, 8).Value = strChoice
Next i

' Fill the data table with unique combinations of index numbers in two
columns
d = 1

For r = 1 To n
For c = r + 1 To n
If r < c Then ' Don't add pairs where both are same
sh.Cells(d + 1, 1).Value = Rnd 'Random Number
sh.Cells(d + 1, 2).Value = r 'Index for choice 1 of pair
sh.Cells(d + 1, 3).Value = c 'Index for choice 2 of pair
d = d + 1
End If
Next c
Next r

'Sort by Random Number Colum
sh.Range("A1:C10000").Sort _
Key1:=Range("A1"), Order1:=xlAscending, _
Header:=xlYes, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal


MsgBox "Setup Complete"

End Sub