Prevent Random combinations to repeat

[Pabzzz]

Hi Excel Masters!!
After a couple of days of searching on the web.. Can't seem to find what I'm looking for.

Here is the problem..
I will choose a combination of 3 numbers from 1 to 8
Every time I recalculate the Sheet, I would like the new generated combination to remember the last drawn combinations.
To prevent the random generator to generate the same combination. The order is not important.
The Drawn Combinations field would populate it self if possible. But I could add them manually.
I'm not sure if this is possible with a formula. Maybe with vba code I guess.

Maybe I'm having trouble formulating my question to be able to find the answer on the web.
English is not my native language
So.. I hope this is clear enough.. at least with the image

Any help will be appreciated

Thanks in advance for your time guys.

 

[maabadi]

First I Create Macro to you should run it first and only one Time.
1. The first InputBox appeared, you should input 8 ( max number for create random number)
2. The 2nd InputBox appeared, you should input 3 ( numbers of set or Digit you want)
3. Then Result of all Combination Pasted at Column M. ( You can change it to what you want ( change column name at last line of Code)

Public Sub MergeArrays()
Dim arr1() As Variant, arr2() As Variant, U As Long, V As Long, W As Long
Dim i As Long, j As Long, k As Long, L As Long, N As Long, M As Long
Dim O As Long, P As Long, Q As Long, S As Long, T As Long, R As Long
    Application.ScreenUpdating = False
    M = 1
    N = Application.InputBox(Prompt:="Enter Max Number to permute:", Type:=1)
    W = Application.InputBox(Prompt:="Enter Digits You want to Show:", Type:=1)
    For i = 1 To N
    ReDim Preserve arr1(i - 1)
     arr1(i - 1) = i
    M = i * M
    Next i
  
    If N < 2 Then Exit Sub
    If N >= 11 Then
        MsgBox "Too many permutations!", vbInformation
        Exit Sub
    End If

    ReDim arr4(M)
    L = 0
    For i = 0 To UBound(arr1)
      For j = 0 To UBound(arr1)
        For k = 0 To UBound(arr1)
          If i <> j And i <> k And k <> j Then
            If W = 3 Then
             arr4(L) = arr1(i) & "," & arr1(j) & "," & arr1(k)
             L = L + 1
            Else
            For O = 0 To UBound(arr1)
            If i <> O And j <> O And k <> O Then
             If W = 4 Then
               arr4(L) = arr1(i) & "," & arr1(j) & "," & arr1(k) & "," & arr1(O)
               L = L + 1
             Else
             For P = 0 To UBound(arr1)
             If i <> P And j <> P And k <> P And O <> P Then
              If W = 5 Then
               arr4(L) = arr1(i) & "," & arr1(j) & "," & arr1(k) & "," & arr1(O) & "," & arr1(P)
               L = L + 1
              Else
              For Q = 0 To UBound(arr1)
               If i <> Q And j <> Q And k <> Q And O <> Q And P <> Q Then
               If W = 6 Then
               arr4(L) = arr1(i) & "," & arr1(j) & "," & arr1(k) & "," & arr1(O) & "," & arr1(P) & "," & arr1(Q)
               L = L + 1
               Else
               For R = 0 To UBound(arr1)
                If i <> R And j <> R And k <> R And O <> R And P <> R And Q <> R Then
                 If W = 7 Then
                     arr4(L) = arr1(i) & "," & arr1(j) & "," & arr1(k) & "," & arr1(O) & "," & arr1(P) & "," & arr1(Q) & "," & arr1(R)
                     L = L + 1
                     Else
                     For S = 0 To UBound(arr1)
                     If i <> S And j <> S And k <> S And O <> S And P <> S And Q <> S And R <> S Then
                     If W = 8 Then
                     arr4(L) = arr1(i) & "," & arr1(j) & "," & arr1(k) & "," & arr1(O) & "," & arr1(P) & "," & arr1(Q) & "," & arr1(R) & "," & arr1(S)
                     L = L + 1
                     Else
                     For T = 0 To UBound(arr1)
                     If i <> T And j <> T And k <> T And O <> T And P <> T And Q <> T And R <> T And S <> T Then
                     If W = 9 Then
                     arr4(L) = arr1(i) & "," & arr1(j) & "," & arr1(k) & "," & arr1(O) & "," & arr1(P) & "," & arr1(Q) & "," & arr1(R) & "," & arr1(S) & "," & arr1(T)
                     L = L + 1
                     Else
                     For U = 0 To UBound(arr1)
                     If i <> U And j <> U And k <> U And O <> U And P <> U And Q <> U And R <> U And S <> U And T <> U Then
                     If W = 10 Then
                     arr4(L) = arr1(i) & "," & arr1(j) & "," & arr1(k) & "," & arr1(O) & "," & arr1(P) & "," & arr1(Q) & "," & arr1(R) & "," & arr1(S) & "," & arr1(T) & "," & arr1(U)
                     L = L + 1
                     End If
                     End If
                     Next U
                    End If
                    End If
                    Next T
                    End If
                    End If
                    Next S
                    End If
                    End If
                  Next R
                 End If
                 End If
                Next Q
                End If
                End If
               Next P
              End If
              End If
             Next O
           End If
          End If
        Next k
       Next j
    Next i
   Range("M1:M" & L + 1).Value = Application.Transpose(arr4)
End Sub

4. Now I Create Second Macro to you see Random number selected from Column M at Cells B5, C5 & D5
5. After Run this macro, The number that created, Delete from Column M & then Not Repeated More.

Sub RandomNumbers2()
Dim Lr As Long, R As Long, L As String
Lr = Range("M" & Rows.count).End(xlUp).Row
R = Application.WorksheetFunction.RandBetween(1, Lr)
L = Range("M" & R).Value
Range("M" & R ).Delete Shift:=Xlup
Range("B5").Value = Left(L, 1)
Range("C5").Value = Mid(L, 3, 1)
Range("D5").Value = Right(L, 1)
End Sub

But if you want to see result as same format at column M at one Cell You can Use this UDF(User Define Function)

Function RandomNumbers() As String
Dim Lr As Long, R As Long, L As String
Lr = Range("M" & Rows.count).End(xlUp).Row
R = Application.WorksheetFunction.RandBetween(1, Lr)
L = Range("M" & R).Value
Range("M" & R ).Delete Shift:=Xlup
RandomNumbers = L
End Function

After Save file as Macro-Enabled Workbook(.xlsm), You can Use this function same as Excel functions. Only Input:

=RandomNumbers()

 

[Pabzzz]

Works perfectly!
If I understand how this works, we need to populate column M with all the possibilities otherwise their would be no way of randomly generating those combinations without a chance of repeating them.

I've tried 70 max numbers and 20 drawn.. getting an error of course. I understand that 161 quadrillion possibilities is way to much to store these combinations.

Do you think there is a way of extracting all those combinations?

I'll be using your macro! Thank you Maabadi!! Very appreciated.

 

[maabadi]

You're Welcome & Thanks for feedback.
I think you give your answer. with that possibilities you suppose it impossible.

 

[Pabzzz]

Haha! That's what I thought..
Thanks for the confirmation