ExcelBanter - create range of cells with random numbers

Assuming I was correct in my last post:

Private Sub CommandButton1_Click()
Dim RetVal As Variant
Dim FullRange As Range
Dim EntriesCount As Long
Dim BinaryArray() As Long

On Error Resume Next

Set RetVal = Application.InputBox("Enter or select the range to fill.", , ,
, , , , 8)
If RetVal Is Nothing Then Exit Sub
Set FullRange = RetVal

RetVal = Application.InputBox("How many entries in total.", , , , , , , 2)
'2 ?
If RetVal = False Then Exit Sub
If RetVal FullRange.Cells.Count Then
MsgBox "Not enough cells in the selected range for " & RetVal & "
entries.", vbExclamation + vbOKOnly
Exit Sub
End If

EntriesCount = RetVal

GenerateRandomArray EntriesCount, BinaryArray()

DistributeBinaryValues FullRange, BinaryArray()

End Sub

Private Function GenerateRandomArray(ElementCount As Long, ByRef
ArrayToFill() As Long)
Dim i As Long

ReDim ArrayToFill(ElementCount - 1)
Randomize
For i = 0 To ElementCount - 1
If Rnd() 0.5 Then
ArrayToFill(i) = 1
Else
ArrayToFill(i) = 0
End If
Next
End Function

Private Function DistributeBinaryValues(ByRef argFullRange As Range,
BinaryValues() As Long)
Dim PlacedCount As Long
Dim RandRow As Long
Dim RandCol As Long
Dim MaxRow As Long
Dim MaxCol As Long

argFullRange.ClearContents

MaxRow = argFullRange.Rows.Count
MaxCol = argFullRange.Columns.Count

Do Until PlacedCount = UBound(BinaryValues) + 1
RandRow = CLng(Rnd * (MaxRow - 1) + 1)
'CLng(Rnd * (high - low)) + low
RandCol = CLng(Rnd * (MaxCol - 1) + 1)

With Cells(RandRow, RandCol)
Debug.Print .Address
If Cells(RandRow, RandCol).Value = "" Then
.Value = BinaryValues(PlacedCount)
PlacedCount = PlacedCount + 1
End If
End With
Loop

End Function

NickHK

"NickHK" ...
So you need 3 states; blank, 0 or 1 ?
With the count of 0s and 1s even to say 100 ?

NickHk

egroups.com...
I would like to, from VBA in Excel, be able to select a range of cells.
And then enter a number for instance 100 and randomly distribute zeros
and ones over the previously selected range of cells to a total of 100.
Some help would be appreciated.