Random N Numbers in an Array

[ionelz]

Hi,
I have this problem :
01. a variable rows N from 1 to 50, in sample N=9 (A1=9)
02. a variable columns C from 1 to 5, in sample C=5 (A2=5)
03. a Requirement R=2 (A3=2)

I did a manually but is difficult when numbers increase
Calculation :
Total of "X"=N*R=18
Limits L=N*R/C=9*2/5=3.6
Since L is not integer, Limits are 3 and 4 ,Integer(L) and integer(L)+1

I need this : every row to have R=2 of "X" and every column 3 and 4

 

[Legacy 143009]

Ok I modified the code like this. I works fine..sort of...

Sub test()
  Dim counter As Long, lRow As Long, lCol As Long, maxCol As Long, L As Long, valR As Long, valL As Double, numRow As Long, numCol As Long
  Dim rng As Range, tmp As Long
  lRow = Cells(Rows.Count, 1).End(xlUp).Row
  lCol = Cells(3, Columns.Count).End(xlToLeft).Column
  valR = Cells(1, 3).Value
  valL = Cells(2, 3).Value
  Set rng = Range(Cells(4, 2), Cells(lRow, lCol))
  counter = 0
  Application.ScreenUpdating = False
  With WorksheetFunction
  numRow = .CountA(Range("A:A"))
  numCol = .CountA(Range("3:3"))
  Do While .CountA(rng) < numRow * valR
    tmp = .CountA(rng)
    For c = 1 To numCol
    L = IIf(maxCol = .RoundUp(numCol / 2, 0), .RoundDown(valL, 0), .RoundUp(valL, 0))
      For r = 1 To numRow
        If .CountA(rng.Rows(r)) < valR And .CountA(rng.Columns(c)) < L Then
          If .RandBetween(0, 1) Then
            rng(r, c).Value = "X"
          End If
        End If
      Next
      maxCol = 0
      For i = 1 To numCol
        If .CountA(rng.Columns(i)) = .RoundUp(valL, 0) Then
          maxCol = maxCol + 1
        End If
      Next
    Next
    If counter Mod 3 = 0 Then
      If .CountA(rng) = tmp Then
        rng.ClearContents
      End If
    End If
    counter = counter + 1
  Loop
  End With
  Application.ScreenUpdating = True
End Sub

Please check the example above. Even it is mathematically possible, my code struggles to find the right combination in a heuristic way (simply randomly). Maybe someone may come up with a better solution. Please check this post. My instincts tell me it is related to your question somehow. You must replace numbers with an X in your case. Sorry for I can't help you further. It is way beyond my skills.

 

[Legacy 143009]

Oh.. Wait a minute... Speaking of the theorical example, if you allow me to add one more X to G17, it can change everything. But in that case there will be 4 fives, and 2 fours. Is it ok? They won't be distributed evenly. But the total will be 28.

 

[ionelz]

N - rows , C - columns , this is the Matrix N * C ( N from 1 to 50, C from 1 to 5 )

R - Requirement (how many of "X" for each N), so we know that, no matter what each row (so each N) have R of "X"

But how we arrange them ?
We also know that Total of "X" = N * R and we need to spread them in Matrix N * C
L=N*R/C (how many of "X" in each C columns

If N=9 and C=5 and R=2
Total of "X" is N * C =18
L= 9*2/5=3.6 so we should have columns with 3 and columns with 4 of "x"

Final we have "X" : 2 per each row and combination 3 and 4 in such a way that TOTAL of them are N*C

In your example, there is no 6, no G column since C is 1 to 5

 

[Legacy 143009]

No, check carefully. There is 6 on 3rd row. I think I fairly well understood the formulas.

My question is let say L:4.7
There are 6 columns.
Do you have a rule how many columns will be 4s and how many 5s?

 

[Legacy 143009]

This will meet your requirements. It worked for 14x9 in the blink of an eye:

Sub test()
  Dim counter As Long, lRow As Long, lCol As Long, maxCol As Long, L As Long, valR As Long, valL As Double, numRow As Long, numCol As Long
  Dim rng As Range, tmp As Long
  lRow = Cells(Rows.Count, 1).End(xlUp).Row
  lCol = Cells(3, Columns.Count).End(xlToLeft).Column
  valR = Cells(1, 3).Value
  valL = Cells(2, 3).Value
  Set rng = Range(Cells(4, 2), Cells(lRow, lCol))
  counter = 0
  Application.ScreenUpdating = False
  With WorksheetFunction
  numRow = .CountA(Range("A:A"))
  numCol = .CountA(Range("3:3"))
  Do While .CountA(rng) < numRow * valR
    tmp = .CountA(rng)
    For c = 1 To numCol
    L = IIf(maxCol = rng.Columns.Count, .RoundUp(valL, 0), .RoundDown(valL, 0))
      For r = 1 To numRow
        If .CountA(rng.Rows(r)) < valR And .CountA(rng.Columns(c)) < L Then
          If .RandBetween(0, 1) Then
            rng(r, c).Value = "X"
          End If
        End If
      Next
    Next
    maxCol = 0
    For i = 1 To numCol
      If .CountA(rng.Columns(i)) = .RoundDown(valL, 0) Then
        maxCol = maxCol + 1
      End If
    Next
    If counter Mod 2 = 0 Then
      If .CountA(rng) = tmp Then
        rng.ClearContents
      End If
    End If
    counter = counter + 1
  Loop
  End With
  Application.ScreenUpdating = True
End Sub

Result:

 

[ionelz]

I believe is working super cool now
Thank you so much
Al I need is to CLEAN B4:F55 before Generate
Also, is possible that at new Generate to get a NEW Random
Right now is ok, but if a keep pressing Generate it stay the same, it doesn't random a new one
But if I manually CLEAN range B4:F55 then all ok

 

[Legacy 143009]

This is how the code looks like in the end. I am also attaching the final version of sample file.

Sub test()
  Dim counter As Long, lRow As Long, lCol As Long, maxCol As Long, L As Long, valR As Long, valL As Double, numRow As Long, numCol As Long
  Dim rng As Range, tmp As Long
  lRow = Range("A" & Rows.Count).End(xlUp).Row
  lCol = Cells(3, Columns.Count).End(xlToLeft).Column
  valR = Range("C1").Value
  valL = Range("C2").Value
  Set rng = Range(Range("B4"), Cells(lRow, lCol))
  rng.ClearContents
  counter = 0
  Application.ScreenUpdating = False
  With WorksheetFunction
  numRow = .CountA(Range("A:A"))
  numCol = .CountA(Range("3:3"))
  Do While tmp < numRow * valR
    For c = 1 To numCol
    L = IIf(maxCol = rng.Columns.Count, .RoundUp(valL, 0), .RoundDown(valL, 0))
      For r = 1 To numRow
        If .CountA(rng.Rows(r)) < valR And .CountA(rng.Columns(c)) < L Then
          If .RandBetween(0, 1) Then
            rng(r, c).Value = "X"
          End If
        End If
      Next
    Next
    maxCol = 0
    For i = 1 To numCol
      If .CountA(rng.Columns(i)) = .RoundDown(valL, 0) Then
        maxCol = maxCol + 1
      End If
    Next
    If counter Mod 2 = 0 Then
      If .CountA(rng) = tmp Then
        rng.ClearContents
      End If
    End If
    tmp = .CountA(rng)
    counter = counter + 1
  Loop
  End With
  Application.ScreenUpdating = True
End Sub

Sample Final.xlsm

1 file sent via WeTransfer, the simplest way to send your files around the world

we.tl

Take care

 

[ionelz]

Thank you very much, you are very good VBA programmer !

 

[Legacy 143009]

Thank you very much, you are very good VBA programmer !

You're welcome Thank you very much, there are way better programmers in this community. They would gladly answer your questions anytime.

Could you please mark my final post as the answer? This will help to other visitors with the same problem to see the solution.

 

[ionelz]

Please Help if you could, with one more question
In above Code

 numCol = .CountA(Range("3:3"))

all I need is ....Range B3:F3, this is MAX (for columns, max is 5)
Because I want to add my other data from H to right side
But if I replace in code with .Range B3:F3, still do not work, meaning still code is looking in right side of column F