Excel VBA - Generate 3 unique random numbers between range

Question

I found the following code and would like to make it generate (3) unique random numbers, stored in X, Y, and Z variables. Can someone help me modify this to add (2) more random numbers stored as variables, and also specify a range for these random numbers in the code?

Sub RandomizeArray(ArrayIn As Variant)
  Dim X As Long, RandomIndex As Long, TempElement As Variant
  Static RanBefore As Boolean
  If Not RanBefore Then
    RanBefore = True
    Randomize
  End If
  If VarType(ArrayIn) >= vbArray Then
    For X = UBound(ArrayIn) To LBound(ArrayIn) Step -1
      RandomIndex = Int((X - LBound(ArrayIn) + 1) * Rnd + LBound(ArrayIn))
      TempElement = ArrayIn(RandomIndex)
      ArrayIn(RandomIndex) = ArrayIn(X)
      ArrayIn(X) = TempElement
    Next
  Else
    'The passed argument was not an array, so put error handler here, such as . . .
    Beep
  End If
End Sub 

My original code which needs the random number to be unique:

Sub FormatSuperProjectHeadings()

        Dim r As Byte, g As Byte, b As Byte
        Dim r2 As Byte, g2 As Byte, b2 As Byte
        Dim spcolor As Integer
            Dim vR(), n As Integer

     'Clear Cells
            n = 3000
            ReDim vR(1 To n)
            For i = 1 To n
                r = WorksheetFunction.RandBetween(0, 127)
                g = WorksheetFunction.RandBetween(0, 127)
                b = WorksheetFunction.RandBetween(0, 127)
                r2 = r + 127
                g2 = g + 127
                b2 = b + 127
                vR(i) = RGB(r2, g2, b2)
            Next i

            Application.ScreenUpdating = False
                Dim MyCell As Range

        With Sheets(1) 'Projects Sheet
            For Each MyCell In .Range("Y5:Y" & .Range("Y" & .Rows.Count).End(xlUp).Row)
                If MyCell = "Super Project" Then
                    MyCell.EntireRow.Interior.Color = vR(WorksheetFunction.RandBetween(1, n))
                    MyCell.Offset(, -22).Font.Bold = True
                End If
            Next
        End With
            Application.ScreenUpdating = True
        End Sub

Answer 1

You usually use a dictionary object if you are looking to generate a unique array of objects. The following code will assign 3 unique values to 3 variables

Random function taken from answer by K.Dᴀᴠɪs

Sub GenerateUniqueValues()
    Dim Dict As Object: Set Dict = CreateObject("Scripting.Dictionary")
    Dim i As Long, x As Long, y As Long, z As Long

    Do Until Dict.Count = 3
        With Dict
            i = Random(0, 127)
            If Not .Exists(i) Then .Add i, i
        End With
    Loop

    x = Dict.keys()(0)
    y = Dict.keys()(1)
    z = Dict.keys()(2)
    Debug.Print x, y, z

End Sub

Function Random(Low&, High&) As Long
   Randomize
   Random = Int((High - Low + 1) * Rnd + Low)
End Function

* And Integrated *

Sub FormatSuperProjectHeadings()

    Dim Dict As Object: Set Dict = CreateObject("Scripting.Dictionary")

    Dim r As Byte, g As Byte, b As Byte
    Dim r2 As Byte, g2 As Byte, b2 As Byte
    Dim spcolor As Integer
    Dim vR(), n As Integer
    Dim i As Long, j As Long

    'Clear Cells
    n = 3000
    ReDim vR(1 To n)
    For i = 1 To n
        Dict.RemoveAll
        Do Until Dict.Count = 3
            With Dict
                j = Random(0, 127)
                If Not .Exists(j) Then .Add j, j
            End With
        Loop
        r = Dict.keys()(0)
        g = Dict.keys()(1)
        b = Dict.keys()(2)
        r2 = r + 127
        g2 = g + 127
        b2 = b + 127
        vR(i) = RGB(r2, g2, b2)
    Next i

    Application.ScreenUpdating = False
    Dim MyCell As Range
    With Sheets(1) 'Projects Sheet
        For Each MyCell In .Range("Y5:Y" & .Range("Y" & .Rows.Count).End(xlUp).Row)
            If MyCell = "Super Project" Then
                MyCell.EntireRow.Interior.Color = vR(WorksheetFunction.RandBetween(1, n))
                MyCell.Offset(, -22).Font.Bold = True
            End If
        Next
    End With

    Application.ScreenUpdating = True
End Sub

Function Random(Low&, High&) As Long
   Randomize
   Random = Int((High - Low + 1) * Rnd + Low)
End Function

Answer 2

This wasn't as simple as I thought it'd be, but here's code to store 3 (or up to however many you want based on the array size) unique numbers in an array:

Sub GetUniqueNumbers()
Dim myarr As Variant
Dim i As Long, j as long
Dim allset As Boolean

ReDim myarr(0 To 2) 'Change array size here

For i = 0 To UBound(myarr)
    Do
        myarr(i) = WorksheetFunction.RandBetween(0, 127) 'Change number range here
        For j = 0 To UBound(myarr)
            If i <> j Then
                If myarr(i) = myarr(j) Then
                    Exit For
                Else
                    If j = UBound(myarr) Then
                        allset = True
                    End If
                End If
            End If
            If j = UBound(myarr) Then
                allset = True
            End If
        Next j
    Loop Until allset = True
    allset = False
Next i

Debug.Print myarr(0)
Debug.Print myarr(1)
Debug.Print myarr(2)
End Sub

Integrating it into your existing code:

Dim myarr As Variant
Sub FormatSuperProjectHeadings()

Dim r As Byte, g As Byte, b As Byte
Dim r2 As Byte, g2 As Byte, b2 As Byte
Dim spcolor As Integer
Dim vR(), n As Integer

'Clear Cells
n = 3000
ReDim vR(1 To n)

For i = 1 To n
    Call GetUniqueNumbers

    r = myarr(0)
    g = myarr(1)
    b = myarr(2)

    r2 = r + 127
    g2 = g + 127
    b2 = b + 127
    vR(i) = RGB(r2, g2, b2)

Next i

Application.ScreenUpdating = False

Dim MyCell As Range

With Sheets(1) 'Projects Sheet
    For Each MyCell In .Range("Y5:Y" & .Range("Y" & .Rows.Count).End(xlUp).Row)
        If MyCell = "Super Project" Then
            MyCell.EntireRow.Interior.Color = vR(WorksheetFunction.RandBetween(1, n))
            MyCell.Offset(, -22).Font.Bold = True
        End If
    Next
End With

Application.ScreenUpdating = True

End Sub
Sub GetUniqueNumbers()

Dim i As Long, j As Long
Dim allset As Boolean

ReDim myarr(0 To 2) 'Change array size here

For i = 0 To UBound(myarr)
    Do
        myarr(i) = WorksheetFunction.RandBetween(0, 127) 'Change number range here
        For j = 0 To UBound(myarr)
            If i <> j Then
                If myarr(i) = myarr(j) Then
                    Exit For
                Else
                    If j = UBound(myarr) Then
                        allset = True
                    End If
                End If
            End If
            If j = UBound(myarr) Then
                allset = True
            End If
        Next j
    Loop Until allset = True
    allset = False
Next i

End Sub

Answer 3

To generate unique numbers you need to check the actual generated number against all previously generated numbers.

Here is an example:

Option Explicit

Public Sub Generate10Numbers()
    Dim Numbers(1 To 10) As Long 'generate 10 numbers
    UniqueRandomNumbersBetween Numbers, 10, 20 'between 10 and 20

    'print all numbers
    Dim No As Variant
    For Each No In Numbers
        Debug.Print No
    Next No
End Sub

Public Function UniqueRandomNumbersBetween(ByRef ReturnNumbers() As Long, LowerBound As Long, UpperBound As Long)
    'check if there are enough numbers to generate them unique
    If UBound(ReturnNumbers) - LBound(ReturnNumbers) > UpperBound - LowerBound Then
        MsgBox "Number range is too small to generate unique numbers"
        Exit Function
    End If

    Dim RndNo As Long
    Dim IsUnique As Boolean

    Dim i As Long, j As Long
    For i = LBound(ReturnNumbers) To UBound(ReturnNumbers)
        Do
            IsUnique = True 'init
            RndNo = WorksheetFunction.RandBetween(LowerBound, UpperBound) 'generate a random number in boundaries
            For j = LBound(ReturnNumbers) To i - 1 'check if it is unique
                If ReturnNumbers(j) = RndNo Then
                    IsUnique = False
                    Exit For
                End If
            Next j
        Loop While Not IsUnique 'loop until a unique number is found
        ReturnNumbers(i) = RndNo 'save the unique number
    Next i
End Function

Answer 4

You can use the following function to generate a random number.

Function Random(Low&, High&) As Long
   Randomize
   Random = Int((High - Low + 1) * Rnd + Low)
End Function

Then your issue as stated:

generate (3) unique random numbers, stored in X, Y, and Z variables

Then you would assign your x, y, and z variables using the above function.

x = Random(1, 3)
do
    y = Random(1, 3)
loop Until y <> x
do
    z = Random(1, 3)
loop until z <> y and z <> x

I'm sure there's a more direct way to do this without using a loop, but this is a start.