Random number/name out of selection + «animation»

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.

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

Good point!

Code:

---

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

---

See if this works

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

Code:

---

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

---

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)?

Code:

---

  For k = 1 To 10

---

Change 10 to eg 30

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...

Try This

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

Code:

---

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

---

or with animation

Code:

---

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

---

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).