Generate Random Char "x" in Range with Condition

Hi,

Please see attached

I have an Range with N rows and X Columns
I want to Randomize N in Range this way :
- Each N appear Y times Horizontal (in any X Columns)
- Each N appear Minimum times in Vertical

Example : N=19 (rows) , X=5 (columns) , Y=3 (condition)
Each N (1,2,3,4, 19) must appear y=3 times in any x=5 Columns
This is Horizontal

But Vertical in Range is tricky because I want to have Minimum of N on each Column X (see attached for this)
Minimum come from the fact that each N appear 3 times but not in 3 columns but in 5 columns in my example

Sub Q2_Ans()
Dim ar, cRng As Range
Dim N As Integer, X As Integer, Y As Integer
Dim r As Integer, c As Integer

Application.ScreenUpdating = False

Sheets("Sheet1").Activate

Range("matrix").ClearContents
ar = Range("Matrix")

Arr = Range("Parameters")

N = Arr(1, 2)
X = Arr(2, 2)
Y = Arr(3, 2)
MaxN = Int((N * Y) / X) + 1

srow = 3: lrow = srow + N - 1

For r = srow To lrow

    For j = 1 To Y
nextc:
        c = WorksheetFunction.RandBetween(1, X) + 2
        If Cells(r, c) <> "" Then GoTo nextc
        Set cRng = Range(Cells(srow, c), Cells(lrow, c))
        nx = Application.CountIf(cRng, "X")
        If nx > MaxN Then GoTo nextc
        Cells(r, c) = "X"
        
    Next j
    
Next r

Application.ScreenUpdating = True


End Sub

Thank you so much, please see attached
That is what I was looking for
The results a very close but not exactly
So Horizontal is fine, they are Y=3 in all rows
But Vertical I should have them EQUAL when M6 is Integer and combination of Int(M6) and Integer(M6)-1 when M6 is not Integer

Administrative Note:

ANOTHER GENERIC THREAD TITLE

We would very much like to help you with your query, however the thread title does not really convey what your request is about. Tell us what you are trying to do, not how you think it should be done.

Please take a moment to amend your thread title. Make sure that the title properly explains your request. Your title should be explicit and not be generic (this includes function names used without an indication of what you are trying to achieve).

Please see Forum Rule #1 about proper thread titles and adjust accordingly. To edit the thread title, open the original post to edit and then click on Go Advanced (bottom right) to access the area where you can edit your title.

(Note: this change is not optional. No help to be offered until this moderation request has been fulfilled.)

In your example, if you're picking any 3 from 5 then you can find out how many options there are for this with:

=COMBIN(5,3)

Which is the same as 5!/(3!*(5-3)!) = 120/6*2 = 120/12 = 10. Your possibilities for putting these in rows are:

11100, 11010, 11001, 10110, 10101, 10011, 01110, 01101, 01011, 00111

So perhaps you could write code to:

1. Generate all the possible combinations
2. Randomly place one of these values in the grid and remove it from the set
3. Move to the next row and repeat
4. If the set it empty, re-generate it

WBD

You'd have to extend on this for more cases but I wrote this in a hurry:

Option Explicit
Public Function Combinations(M As Long, N As Long)

Dim outputSize As Long
Dim stack As New Collection
Dim index As Long
Dim value As Long
Dim I As Long
Dim c As Long

outputSize = Combin(M, N)

ReDim comb(outputSize - 1, M - 1)
ReDim result(M - 1) As Long

c = 0
stack.Add 0
While stack.Count > 0
    index = stack.Count - 1
    value = stack(stack.Count)
    stack.Remove stack.Count
    Do While (value < N)
        value = value + 1
        result(index) = value
        index = index + 1
        stack.Add value
        If index = M Then
            For I = 0 To M - 1
                comb(c, I) = result(I)
            Next I
            c = c + 1
            Exit Do
        End If
    Loop
Wend

Combinations = comb

End Function
Private Function Combin(M As Long, N As Long) As Long

Dim A As Long
Dim B As Long

Combin = 1
A = N - M
B = N
While B > M
    Combin = Combin * B
    B = B - 1
Wend
While A > 1
    Combin = Combin / A
    A = A - 1
Wend

End Function
Public Sub FillGrid()

Dim N As Long
Dim X As Long
Dim Y As Long
Dim D As New Collection
Dim R As Long
Dim A
Dim I As Long
Dim J As Long

N = Range("M2").value
X = Range("M3").value
Y = Range("M4").value

ReDim Z(Y - 1)

For R = 1 To N
    If D.Count = 0 Then
        A = Combinations(Y, X)
        For I = 0 To UBound(A)
            For J = 0 To Y - 1
                Z(J) = A(I, J)
            Next J
            D.Add Z
        Next I
    End If
    I = Int(Rnd * D.Count)
    A = D.Item(I + 1)
    For J = 0 To Y - 1
        Cells(R + 2, A(J) + 2).value = "X"
    Next J
    D.Remove I + 1
Next R

End Sub

Clear the grid then run the FillGrid macro.

WBD

Sub Q2_Ans()
Dim ar, cRng As Range, rng As Range
Dim N As Integer, X As Integer, Y As Integer
Dim r As Integer, c As Integer

Application.ScreenUpdating = False

Sheets("Sheet1").Activate

Arr = Range("Parameters")

N = Arr(1, 2)
X = Arr(2, 2)
Y = Arr(3, 2)

Z = (N * Y) / X
If Z = Int(Z) Then
maxn = Z
Else
 maxn = Int(Z + 1)
End If

Range("B3:H50").ClearContents
srow = 3
lrow = srow + N - 1
Set rng = Range("B3:G" & lrow)

idx = 1
For r = srow To lrow
    Cells(r, 2) = idx
    idx = idx + 1
Next r

For r = srow To lrow

    For j = 1 To Y
nextc:
        If Cells(r, 8) >= 1 Then
           minv = WorksheetFunction.Min(Range("colN"))
           c = Application.Match(minv, Range("Coln"), 0) + 2
           If Cells(r, c) <> "" Then c = WorksheetFunction.RandBetween(1, X) + 2
        Else
          c = WorksheetFunction.RandBetween(1, X) + 2
        End If
        If Cells(r, c) <> "" Then GoTo nextc
        Set cRng = Range(Cells(srow, c), Cells(lrow, c))
        nx = Application.CountIf(cRng, "X")
        If nx >= maxn Then GoTo nextc
        Cells(r, c) = "X"
        Cells(r, 8) = Cells(r, 8) + 1
    Next j
    
    If Range("Finish") = N Then Exit For
    
Next r

Application.ScreenUpdating = True


End Sub

Sir, SUPER THANK YOU
Looking now and so far so good, I will let you know
I found so far one think that, Matrix Range is not defined correct
I mean because N change, bottom right corner of Matrix should "live" change too

Also please look into Set rng = Range("B3:G" & lrow)
It should NOT be G, it again should be "B + X"
If x=5 then yes is G but if X=4 then is F
Also I will make sure in my input data validation that always Y<=X

Maximum value of X ?

Will look at this tomorrow.

Checked and all looks good
Max X is 5 and Min X is 3
Also Y <=X but I will take care of X and Y in my data validation

I'd started on this so I'll post what I did. Not trying to tread on toes but it might be useful for someone else in the future. Fill in the values, click "Generate" and it will create a new sheet with the table.

WBD

Originally Posted by WideBoyDixon

I'd started on this so I'll post what I did. Not trying to tread on toes but it might be useful for someone else in the future. Fill in the values, click "Generate" and it will create a new sheet with the table.

WBD

Could you please do a modification ?
At Generate it create new Sheets (Sheet1, Sheet2 ....Sheetn)
I want to use the data from Sheet1 so I want to write my formulas relative to Sheet1
Could you please overwrite at Generate only in Sheet1 ?
This is regarding file attached at post #13
Thank you

Please post a sample workbook.

I've adapted the macro in the attached. You'll need to run FillGrid().

WBD

Originally Posted by WideBoyDixon

I've adapted the macro in the attached. You'll need to run FillGrid().

WBD

Please see attached
This is my last try !
I do not want to bug you with this , I am sure you have to answer to may others
Thank you so much for your effort

- Matrix is N x A cells
- Fill with "x", N x B cells(B<=A)
Required :
- Each N have B "x" (each Row have B "x")
- Each Column (each A) have N x B /A "x"

In words :
A group of N people need to work B (B<=A) days out of A days (A=1,2,3,4,5), so max A is 5
How to spread them in such a way that they are MINIMUM number per day

OK. Trying to distribute the "x" in the columns adds an extra layer of complexity that I don't think can be easily solved. I can't even begin to think how you would solve that. If you don't want random answers then it might be possible to hard-code it but with the current solution, I can't help.

WBD

Well, but please see and test your post #13 which works absolutely PERFECT, for any N, A, or B !!!!
That is exactly what I want
Except, that it create new Sheet for every Generate
That is cool too, but all the modification I need to post #13 is to Generate in Sheet1 and then overwrite there in Sheet1 regardless of how may times I press Generate

That's what I posted in post #19

WBD

OK. Once that try then

I've changed this so it auto-generates when you change any of the parameters.

WBD

Thank you so much ! All done now
Maybe one more thing if possible : lost Undo

You can't undo macros.

WBD