Prevent Random combinations to repeat

Pabzzz

New Member
Joined
Nov 23, 2019
Messages
5
Office Version
  1. 2016
Platform
  1. Windows
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.
 

Attachments

  • exemple random combination preventer.png
    exemple random combination preventer.png
    15.6 KB · Views: 16

Excel Facts

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.

maabadi

Well-known Member
Joined
Oct 22, 2012
Messages
1,836
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
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)
VBA 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.
VBA Code:
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)
VBA Code:
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:
Excel Formula:
=RandomNumbers()
 
Last edited:
Solution

Pabzzz

New Member
Joined
Nov 23, 2019
Messages
5
Office Version
  1. 2016
Platform
  1. Windows
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

Well-known Member
Joined
Oct 22, 2012
Messages
1,836
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
You're Welcome & Thanks for feedback.
I think you give your answer. with that possibilities you suppose it impossible.
 

Pabzzz

New Member
Joined
Nov 23, 2019
Messages
5
Office Version
  1. 2016
Platform
  1. Windows
Haha! That's what I thought..
Thanks for the confirmation (y)
 

Watch MrExcel Video

Forum statistics

Threads
1,130,138
Messages
5,640,335
Members
417,139
Latest member
madcabbie

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top