PDA

View Full Version : Unique random number from array, VBA



Maxim33
04-22-2021, 12:51 PM
Hello, new to VBA here. I am trying to make a Mafia (social deduction game) presentation to play with my friends. I have a slide with a portrait of a friend with a questionmark on their face and 5 hidden card-role pictures, and i want it so that when you click the questionmark portrait it would disappear and instead a random role-card picture would appear. And do the same thing 5 times. But the problem is that the roles are unique, that means that each time the random function has to remember the previous result.
I don't know anything about syntax so far, but i would love to hear an oppinion weather this would work, and maybe some syntax solutions. Not using arrays here as it is just 5, maybe wrong. So i think it should be somethink like:
create 5 checkboxes a1, a2, a3, a4, a5. Set their value to 0. Define b as random (1 to 5) int. And execute as follows:
if b=1 and a1=0 set a1=1 and perform an animation event for card-role picture 1 to appear;
if b=2 and a2=0 set a1=1 and perform an animation event for card-role picture 2 to appear;
......
same for b=5

Hope this makes sence.

SamT
04-23-2021, 10:30 AM
I designed this so that it can easily handle any number of players selected from a list of members, which are assigned a random Role from an unlimited list of possible roles

The result is that Assignments is a 2D array wherethe first "column" is a random list of player names and the second "Column" is a list of randomly assigned Role Names.

It Complies, but is untested
Option Explicit

Dim Assignments As Variant
Dim NumPlayers As Long
Dim NumRoles As Long

Sub Main()
NumPlayers = 5 'NumPLayers Can be set by UserForm
NumRoles = 5 'NumRoles Can be set by UserForm
ReDim NewPlayers(1 To NumPlayers)
ReDim Roles(1 To NumPlayers)
ReDim Assignments(1 To NumPlayers, 1 To 2)
Dim NextPlayer, NextRole, Newrole
Dim P As Long, R As Long, i As Long

'Set Players in Random order
For P = 1 To NumPlayers
ResetRandomPlayer:
NextPlayer = MemberNames(RandomNumbers(UBound(MemberNames))) 'UBound member names is Upper Limit for Random numbers
For i = 1 To UBound(Assignments)
If NextPlayer = Assignments(i, 1) Then GoTo ResetRandomPlayer 'No Duplicates
Next i
Assignments(P, 1) = NextPlayer

'Set Roles in Random order
ResetRandomRole:
NextRole = PossibleRoles(RandomNumbers(UBound(PossibleRoles)))
For i = 1 To UBound(Assignments)
If NextRole = Roles(i) Then GoTo ResetRandomRole
Roles(i) = NextRole 'Store Next Role for Duplicate Check
Next i
Assignments(P, 2) = NextRole
Next P
End Sub





Function MemberNames() As Variant
'MemberNames can be replaced by a UserForm
MemberNames = Array("Adam", "Bill", "Charles", "Dan", "Edward")
End Function

Function PossibleRoles() As Variant
PossibleRoles = Array("King", "Queen", "Bishop", "Knight", "Rook") 'List all possible roles
End Function

Function RandomNumbers(UpLimit As Long) As Long
'Your code here.
'Code for numbers from 1 to UpLimit
End Function

Maxim33
04-23-2021, 11:54 AM
Thanks for the reply! I am going to check it out! So far i made this bit of code work for 5 players with 3 roles (2 of wich duplicated):

Sub RRS()
Dim flag As Boolean
flag = True
While flag
Randomize
Randomnumber = Int((5 * Rnd) + 1)
If Randomnumber = 1 And Slide5.a1.Caption = 0 Then
Slide5.a1.Caption = 1
ActivePresentation.SlideShowWindow.View.GotoSlide (7)
flag = False
ElseIf Randomnumber = 2 And Slide5.a2.Caption = 0 Then
Slide5.a2.Caption = 1
ActivePresentation.SlideShowWindow.View.GotoSlide (7)
flag = False
ElseIf Randomnumber = 3 And Slide5.a3.Caption = 0 Then
Slide5.a3.Caption = 1
ActivePresentation.SlideShowWindow.View.GotoSlide (8)
flag = False
ElseIf Randomnumber = 4 And Slide5.a4.Caption = 0 Then
Slide5.a4.Caption = 1
ActivePresentation.SlideShowWindow.View.GotoSlide (8)
flag = False
ElseIf Randomnumber = 5 And Slide5.a5.Caption = 0 Then
Slide5.a5.Caption = 1
ActivePresentation.SlideShowWindow.View.GotoSlide (9)
flag = False
ElseIf Slide5.a1.Caption = 1 And Slide5.a2.Caption = 1 And Slide5.a3.Caption = 1 And Slide5.a4.Caption = 1 And Slide5.a5.Caption = 1 Then
MsgBox "Press Play!"
flag = False
End If
Wend
End Sub

Nothing fancy for sure, but that works heh. I also made a logic using arrays but was struggling with their syntax. Stuff like UBound(Rarray) - LBound(Rarray) + 1 instead of array length; Redim and so on.
Thanks again for looking into it and showing good solution!