Pull distinct number from independant columns

[NightCa]

Hello everybody. These days I've been trying to find a function that can pull a number from each column in a selected range so that all pulled numbers are different.
For example, if the Starting columns are A:[1,3,5], B[1,2,3], C[4,6], D[1], a possible solution could be [3,2,6,1], or [5,2,4,1]. Note that there are dependancies between columns: for example, 1 can't be pulled from column A because there would be no numbers to pull in D. So far the best answer i could get is to pull numbers randomly until you get a valid solution. I was wondering if there was a way to not use this recursive method, but a more deterministic approach, to always get distinct numbers (if not impossible).

 

[Legacy 143009]

I was neither able to understand what the other code does nor make it work.

Here find my sample file: Sample.xlsm

Go to every 1000th row and try to understand what I did. I placed every unique number at those check points. That means my code has 1/10000 chance to find the correct row randomly. This is quite a task!

Even my humble laptop was able to complete it in just around 1.5 seconds. You can locate the time benchmark in L1 cell after running.

 

[NightCa]

I was neither able to understand what the other code does nor make it work.

Here find my sample file: Sample.xlsm

Go to every 1000th row and try to understand what I did. I placed every unique number at those check points. That means my code has 1/10000 chance to find the correct row randomly. This is quite a task!

Even my humble laptop was able to complete it in just around 1.5 seconds. You can locate the time benchmark in L1 cell after running.

is there any way the VBA can be rewritten into an udf that contains the selected range (in the case of your sample case A1:J10000) and returns a horizontal array with the solution (in the case of your sample 1 2 3 4 5 6 7 8 9 10)? I'd do it myself but i don't know how. Thank you in advance

 

[Legacy 143009]

Here find the sample file: Sample2.xlsm

I converted my code to a function and put it in a standard module. Because it is a worksheet function, it works much slower. I reduced my sample up to 100 rows.
In order to use the formula, you must pay attention to two points:
1. First select the cells those you want to spill the results (in this example you can select K1 to T1) then click to formulabar and begin to write =getRandom
2. This is an array formula. After writing the formula (in this example =getRandom(A1:J100)) you must press Ctrl+Shift+Enter together. The function will spill the result to selected cells.

Function getRandom(rng As Range) As Variant()
  Dim myRange As Variant, resultArr As Object, rndRow As Long, results As Variant, counter As Long
  myRange = rng
  Set resultArr = CreateObject("Scripting.dictionary")
  For i = 1 To UBound(myRange, 2)
  counter = 0
    Do
      rndRow = (Timer * Rnd) Mod (UBound(myRange, 1) - 1 + 1) + 1
      If Not resultArr.exists(myRange(rndRow, i)) And Not IsEmpty(myRange(rndRow, i)) Then
        resultArr.Add myRange(rndRow, i), 1
        Exit Do
      Else
        counter = counter + 1
        If counter = UBound(myRange, 1) Then
          resultArr.RemoveAll
          i = 1
        End If
      End If
    Loop
  Next
  results = Array(resultArr.keys, resultArr.items)
  getRandom = results
End Function

 

[NightCa]

Here find the sample file: Sample2.xlsm

I converted my code to a function and put it in a standard module. Because it is a worksheet function, it works much slower. I reduced my sample up to 100 rows.
In order to use the formula, you must pay attention to two points:
1. First select the cells those you want to spill the results (in this example you can select K1 to T1) then click to formulabar and begin to write =getRandom
2. This is an array formula. After writing the formula (in this example =getRandom(A1:J100)) you must press Ctrl+Shift+Enter together. The function will spill the result to selected cells.

Function getRandom(rng As Range) As Variant()
  Dim myRange As Variant, resultArr As Object, rndRow As Long, results As Variant, counter As Long
  myRange = rng
  Set resultArr = CreateObject("Scripting.dictionary")
  For i = 1 To UBound(myRange, 2)
  counter = 0
    Do
      rndRow = (Timer * Rnd) Mod (UBound(myRange, 1) - 1 + 1) + 1
      If Not resultArr.exists(myRange(rndRow, i)) And Not IsEmpty(myRange(rndRow, i)) Then
        resultArr.Add myRange(rndRow, i), 1
        Exit Do
      Else
        counter = counter + 1
        If counter = UBound(myRange, 1) Then
          resultArr.RemoveAll
          i = 1
        End If
      End If
    Loop
  Next
  results = Array(resultArr.keys, resultArr.items)
  getRandom = results
End Function

the fact that i must select all the spilling cells whenever i use this function (if i understand it correctly) is pretty inconvenient. Also, i don't really understand how to do the first step because excel allows me to select a single cell only to put my function into. This could be fixed by putting all solution in a single cell, divided by something, and later using the TEXSPLIT formula, which would work fine. Sorry for my ignorance but i really don't understand how to do that first step

 

[NightCa]

Also, I asked the author of the function i showed you to explain how the code works. He told me that it "Reads the data from A1 to consecutive block of area and calculates all the combinations that have unique item in all columns using the elements in each column and randomly select one from them for solution."

 

[NightCa]

I just realised that the udf wasn't working because the vba was seen as a virus. Now it works perfectly fine, but there is still the issue of f9 not working when i want to change the sequence. Also i noticed that under the solution there is a sequence of ones

. Let me know if the method from the other function could be any faster, but I don't know if that information is enough to tell.

 

[Legacy 143009]

Sorry. This is the best I can. Maybe you should wait for another help.

 

[NightCa]

don't worry man, you helped me a gerat deal on this

 

[Legacy 143009]

You may want to check this: UserDefinedFunction is not refreshed when recalcing w F9
And this: Application.Volatile method (Excel)
Just add this Application.Volatile to the first line of the function.

 

[NightCa]

Thanks for this, I will add it now. Do you have any idea why the function gives a series of ones though?