jeudi 15 octobre 2020

Goal: randomization without doubling up two names Problem: comparing and writing (to worksheet) collection and/or arrays

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