Random number/name out of selection + «animation»

[Gollom]

Hi,

First post!
I hope someone can give me some pointers to help me with my challange.

I would like to make a setup that allow me to push a button in PP and it draws a name/number based on a «table» where I fill in the various names/numbers. This «table» should be in a hidden slide. I found a nice macro that did these things, but that also had pop-ups that asked for lowest and highest number. I dont want that (since it should be based on a given set of names/Numbers). A really nice feature it had was that once the «randomize» button was pushed it displayed random numbers in rapid sucsession before it stopped and displayed the choosen number.

Any help would be greatly appreciated.

[John Wilson]

A good move would be to show the macro you tried!

[Gollom]

Good point!


Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Dim chosenNum As Integer
Dim I As Integer
Dim k As Integer
Sub randomNumber()
lowRand = InputBox("What's the lowest possible random number to choose?")
maxRand = InputBox("What's the largest possible random number to choose?")
Randomize
For k = 1 To 10
chosenNum = Int((maxRand - lowRand) * Rnd) + lowRand
With ActivePresentation.SlideShowWindow.View.Slide.Shapes(2).TextFrame.TextRange
.Text = chosenNum
End With
For I = 1 To 1
Sleep (50)
DoEvents
Next
Next
End Sub

[John Wilson]

See if this works

1 gives a number up to 20 (change to suit) and 2 a name from a list (edit the list)


Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Dim chosenNum As Integer
Dim I As Integer
Dim k As Integer


Sub randomNumber()

Const maxRand = 20 ' change value to suit
Randomize
For k = 1 To 10
chosenNum = Int((maxRand - 1) * Rnd) + 1
With ActivePresentation.SlideShowWindow.View.Slide.Shapes(2).TextFrame.TextRange
.Text = chosenNum
End With
For I = 1 To 1
Sleep (50)
DoEvents
Next
Next
End Sub


Sub randomNumber2()
Dim strname As String

Dim maxRand
Dim rayNames() As String
' change comma sep list to suit
rayNames = Split("John, Fred, Bill, Tony, Mary", ",")
maxRand = UBound(rayNames)
Randomize
For k = 1 To 10
chosenNum = Int(maxRand) * Rnd
strname = rayNames(chosenNum)
Debug.Print strname
With ActivePresentation.SlideShowWindow.View.Slide.Shapes(2).TextFrame.TextRange
.Text = strname
End With
For I = 1 To 1
Sleep (50)
DoEvents
Next
Next
End Sub

[Gollom]

Thank you very much, John!

It worked just as I wanted it too. I can add numbers in front of the names and only use "nr.2".
I managed to change the speed of the "rolling" names, but is there any way to decide how many names that will be shown before the final name is chosen? I really like the effect, but it could last longer.

If you dont mind I would also ask for guidance on how to display the selected/chosen name in a seperate shape on the same slide ("Winners: *12 John *78 Terry, etc)?

[John Wilson]

For k = 1 To 10

Change 10 to eg 30

[Gollom]

Works like a charm! I really appreaciate your help!

It got it to look visually good, but now I started to question if I am getting the "results" that I need.
It will be used as a tool for a lottery drawing. There will be three prizes, and three drawings.
All participants have picked one, two or three numbers each.
I must ensure that the number/name being drawn in the first drawing is not a part of the second/third drawing. Same goes for the number being picked in the second drawing, etc.

I am no expert (as you already know), but as the code is now, all numbers are "in play" each time I activate the macro.
Any suggestions on how to make sure that this is a fair and correct lottery?

Maybe this is more a mathematical problem than a technical one...

[John Wilson]

Try This

Run starthere just the first time and then choose numbers with RndChoice


Dim rayNums() As String

Sub RndChoice()
Dim K As Long
Dim lngrnd As Long
Dim lngNum As Long
Randomize
lngrnd = Int(Rnd * UBound(rayNums)) + 1
ActivePresentation.Slides(1).Shapes(2).TextFrame.TextRange = rayNums(lngrnd)
rayNums(lngrnd) = rayNums(UBound(rayNums))
If UBound(rayNums) > 1 Then
ReDim Preserve rayNums(1 To UBound(rayNums) - 1)
Else
starthere
End If
End Sub


Sub starthere()
'Highest number
Dim C As Long
Const lngHigh As Long = 20
ReDim rayNums(1 To lngHigh)
For C = 1 To lngHigh
rayNums(C) = CStr(C)
Next C
ActivePresentation.Slides(1).Shapes(2).TextFrame.TextRange = "First Number"
End Sub

[John Wilson]

or with animation


Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)Dim rayNums() As String


Sub RndChoice()
Dim K As Long
Dim N As Long
Dim lngrnd As Long
Dim lngNum As Long
Randomize
lngrnd = Int(Rnd * UBound(rayNums)) + 1
For K = 1 To 20
Randomize
ActivePresentation.Slides(1).Shapes(2).TextFrame.TextRange = Int(Rnd * UBound(rayNums)) + 1
Sleep (50)
DoEvents
Next
ActivePresentation.Slides(1).Shapes(2).TextFrame.TextRange = rayNums(lngrnd)
rayNums(lngrnd) = rayNums(UBound(rayNums))
If UBound(rayNums) > 1 Then
ReDim Preserve rayNums(1 To UBound(rayNums) - 1)
Else
starthere
End If
End Sub

Sub starthere()
'Highest number
Dim C As Long
Const lngHigh As Long = 20
ReDim rayNums(1 To lngHigh)
For C = 1 To lngHigh
rayNums(C) = CStr(C)
Next C
ActivePresentation.Slides(1).Shapes(2).TextFrame.TextRange = "First Number"
End Sub

[Gollom]

Thank you once again, John!

Is there a way to have run starthere and RndChoice without manually choose one or the other?
In my layout I have one field/button I push to draw the numbers, and it would be better if I did not have to assign RndChoice to a different button.

Maybe I should start a new thread for this, but is it possible to have the number/names that are drawn to be moved to a seperate textbox on the same slide?

Run Starthere - name/number is drawn and shown in one textbox
Run RndChoice - first name/number is shown in another textbox on same slide - a new number/name is drawn
Run again - second name/number is shown in another textbox on same slide (below first name/number) - a new number/name is drawn and shown in another textbox on same slide (below second name/number).