Random N Numbers in an Array

I

ionelz

Board Regular
Joined
Jan 14, 2018
Messages
248
Office Version
  1. 365
Platform
  1. Windows
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

1674169737625.png
 
Sort by date Sort by votes
Ok. Replace these two lines

VBA Code: 
lCol = 6

VBA Code: 
numCol = 5

This should be enough
 
Last edited by a moderator:
Upvote 0

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.
1674395597716.png
1674395639052.png
1674395695776.png

There was something bothering me with the code. Look at to the results that I have shared. There is an inhomogeneous distribution. Most of the time Xes are weighted from top-left to bottom-right which bothers me because it is not "truly" random. I made a small modification to the code which allows a more evenly distribution:
VBA Code: 
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 = 6
  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 = 5
  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 r > .RandBetween(numRow * -1, numRow * 2) And .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 3 = 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
1674396566848.png
 
Last edited by a moderator:
Upvote 0
Yes, I can not yet make it work ! but I did not know how to ask you again
 
Upvote 0
I issue I have is this :
- all Ok on Rows, I can add/remove them
- all Ok on adding data to right side of column G
- NOT Ok when I remove 5 from B3:F3, it still doing for column F
Before "FIXING" lCol=6 numCol=5 I was able to do this too (remember that I could have on columns 1 to max 5)

1674397710086.png
 
Upvote 0
Is it ok now? Are you happy with the result? Or do you have any more questions? Please feel free to ask. By the way I forgot a comment in the code. Please delete quotation mark. It will make the code faster.
 
Upvote 0
How about like this? Please send feedback:
VBA Code: 
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, 7).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 = lCol - 1
  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 r > .RandBetween(numRow * -1, numRow * 2) And .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 3 = 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
This will work if you leave column G always empty.
 
Upvote 0
Now is Ok with Columns too but Clear Range Content should always apply to B4:F100, regardless how many Columns in B3:F3, just to be sure that nothing is there
Meaning now for example, I can delete 5 but Results from preview remain in F4:F100
I then can delete even 4 but results remain in E4:F100 from preview
Yes, G I will leave it empty
 
Last edited:
Upvote 0
Try:
VBA Code: 
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, 7).End(xlToLeft).Column
  valR = Range("C1").Value
  valL = Range("C2").Value
  Set rng = Range(Range("B4"), Cells(lRow, lCol))
  Range("B4:F" & lRow).ClearContents
  counter = 0
  Application.ScreenUpdating = False
  With WorksheetFunction
  numRow = .CountA(Range("A:A"))
  numCol = lCol - 1
  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 r > .RandBetween(numRow * -1, numRow * 2) And .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 3 = 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
Now how is it?
 
Upvote 0
Ok now but I hope you do not maid !
For B3:F3, I use I4 and formula us you see to get 1 2 3 4 5
So if I4=4, F3 is EMPTY but now because at F3 is a Formula, VBA stiil believe something is there and is running resluts in F
Same I do for N, for A4:A100, I will use I3 and formula with Rows(A$4:A4) so after 20 it still run results becuase there is a formula in cells
1674400077189.png
 
Last edited:
Upvote 0
If you are always going to use I3 and I4, this could work. Also you can change it by yourself in the future:
VBA Code: 
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("I3").Value + 3
  lCol = Range("I4").Value + 1
  valR = Range("C1").Value
  valL = Range("C2").Value
  Set rng = Range(Range("B4"), Cells(lRow, lCol))
  Range("B4:F" & Rows.Count).ClearContents
  counter = 0
  Application.ScreenUpdating = False
  With WorksheetFunction
  numRow = .CountA(Range("A:A"))
  numCol = lCol - 1
  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 r > .RandBetween(numRow * -1, numRow * 2) And .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 3 = 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
 
Last edited by a moderator:
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Solved
Previously working very complex VBA now stopped
Replies
7
Views
216
Alex Blakenburg
A
K
  • Solved
My VBA is only copying the last row of data instead of all the rows
2 3
Replies
24
Views
690
Alex Blakenburg
A
K
  • Question
conditional formatting question
Replies
2
Views
231
kerm007
K
J
  • Solved
Vba code to generate a list of numbers in random order
Replies
4
Views
383
Fluff
Fluff
zookeepertx
  • Question
Having trouble "deciphering" some code so I can see how it works
Replies
7
Views
134
zookeepertx
zookeepertx

Forum statistics

Threads
1,216,102
Messages
6,128,853
Members
449,471
Latest member
lachbee

Share this page

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
Back
Top