Solved: Draw without repeating words until the entire list has been drawn

[marreco]

Hi

I need to create a random drawing as follows.
I have a list of ten words tab ("Words")
I need that tab ("Result) in a cell (C3) I appear only a single word.

But there is that comes my problem.

when a word appears in the guide ("Result) in cell (C3) this word should not appear until more than the other nine words has left the random draw.

[p45cal]

No time to do the coding right now, but this can be done by putting 10 random numbers (you can put a =RAND() formula there) next to the ten words in the Words sheet, sorting both columns by the random numbers, working your way through the ten words from top to bottom. When all 10 have been drawn, sorting again (there will be new random numbers by that time if that sheet recalculates).

[marreco]

I swear I got lost and full of doubt.:dunno

Can demonstrates this with a file?

Thank you!

[Paul_Hossler]

This is p45cal's approach in VBA. It takes a range of words, generates random numbers, sorts to make sure each word is used one time

It can be done with WS formulas I guess, but I prefer the VBA approach


Option Explicit
Sub SORTEIO()
Calculate
End Sub
Function RandomWords(rWords As Range, NeedTimeToForceRecalc As Date) As Variant
Dim aWords As Variant
Dim aOrder() As Double
Dim i As Long, j As Long
Dim x As Double
Dim w As String
aWords = Application.WorksheetFunction.Transpose(rWords.Columns(1).Value)

ReDim aOrder(LBound(aWords) To UBound(aWords))

For i = LBound(aWords) To UBound(aWords)
aOrder(i) = Rnd
Next i
For i = 1 To UBound(aOrder) - 1
For j = i + 1 To UBound(aOrder)
If aOrder(i) > aOrder(j) Then
x = aOrder(i)
w = aWords(i)
aOrder(i) = aOrder(j)
aWords(i) = aWords(j)
aOrder(j) = x
aWords(j) = w
End If
Next j
Next i

RandomWords = aWords
End Function


Look at the Green Col K on 'Results' to see what I mean. Only thing a little tricky is to remember to array-enter the formula

Paul

[marreco]

Hello Paul, thanks for replying.

I do not even know if I understand what you did but I have a problem.

like I have 10 words, if the seventh word out of the list (as drawn), only 9 words should come out (as drawn) in the list.

we had another draw, so let's say the second word list left in the draw.

I now have only 8 words to be drawn, and so on

see that after 10 sweepstakes now rather SEVENTH word list could go out in the draw.

[p45cal]

See attached, which contains:
- RAND() formulae in Words (you'll have to copy down more if the list is longer than 10 words)
- A counter in cell E1 of Words to keep track of how far down the list we have reached.
- An amended SORTEIO sub:
Sub SORTEIO()
With Sheets("Words")
If .Range("E1") > Range("MATRIZ_PALAVRAS").Rows.Count Then
Range("MATRIZ_PALAVRAS").Resize(, 2).Sort Key1:=Sheets("Words").Range("B1"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal 'resort
.Range("E1") = 1
MsgBox "starting again by re-sorting"
End If
Sheets("Result").Range("C3").Value = Application.Index(.Range("MATRIZ_PALAVRAS"), .Range("E1").Value)
.Range("E1").Value = .Range("E1").Value + 1
End With
End Sub

[marreco]

Hi.
was magnificent, perfect!!:rotlaugh:
thank you very much!