I am trying to write a simple randomizing program that reads from a column of names and randomly writes them to three columns of four. I have something that kind of works, but it is duplicating my names and I can figure out how to fix it with arrays or collections as those wont let me compare values. Thank you in advance.
Goal: randomization without doubling up two names
Problem: comparing and writing (to worksheet) collection and/or arrays
Option Explicit
Private Sub Randomize_Click()
Dim HowMany As Integer
Dim NoOfNames As Long
Dim RandomNumber As Integer
Dim Names(), dub() As String 'Array to store randomly selected names
Dim i, j, r, a, p As Byte
Dim CellsOut As Long 'Variable to be used when entering names onto worksheet
Dim ArI As Byte 'Variable to increment through array indexes
Application.ScreenUpdating = False
HowMany = 4 ' use with a third loops?
CellsOut = 4
For a = 1 To 6
For r = 1 To 3
For j = 2 To 5
'CellsOut = i 'turn this into loops
ReDim Names(1 To 4) 'Set the array size to how many names required
NoOfNames = Application.CountA(Worksheets("Employees").Range("A:A")) - 1 ' Find how many
names in the list
i = 1
Do While i <= HowMany
RandomNo:
RandomNumber = Application.RandBetween(2, NoOfNames + 1)
dub = RandomNumber
'dub.Add Unit.Value
If Names(i) = Cells(RandomNumber, 1).Value Then
'If Names(i) = dub(Unit) Then
GoTo RandomNo
End If
Names(i) = Worksheets("Employees").Cells(RandomNumber, 1).Value ' Assign random
name to the array
i = i + 1 '
Loop
'Loop through the array and enter names onto the worksheet
For ArI = LBound(Names) To UBound(Names)
Cells(CellsOut, j) = Names(ArI)
CellsOut = CellsOut + 1
Next ArI
Application.ScreenUpdating = True
CellsOut = 4
Next j
Next r
Next a
End Sub
Aucun commentaire:
Enregistrer un commentaire