Code to pick random cell and change value not working as expected

[miicker]

Hi Everyone,

I have created some code, and what it should do is select row 5, starting in column F tot the last filled cell of that row, so for example F5:ZZ5 and change all values to "No". Next it prompts the user to enter a number, for example "20", it now puts 20 random values in the range F5:ZZ5 to "Yes".
So far it works decent, but because it puts random cells to "Yes", it could happen that it puts the same cell to "Yes" multiple times.

To solve this I've edited the code, I've counted the number of cells which contain the value "Yes" and if it was less then the number the user entered, the code runs again. This works fine if the user fills in the number 20 (at least when the range contains about 250 cells). But when the user fills in the number 100, there is no way it works, because the code always replaces all values in range with "No" again.

So what I wanted to do when the count of cells with value "Yes" is less then the user entered, is select all cells in range with value "No" and fill the remaining number with the value "Yes", also at random, so that the number that the user entered is always equal to the number of cells set to "Yes".
This part of the code, unfortunately, fails. It fails because the range contains skips, so for example F5 and G5 are set to no, H5 and I5 are set to yes and J6 is set to no. F5, G5 and J6 are selected. But for some reason I don't understand, the code also changes values in the next row. It seems like the more skips I have in the selection, the more rows are used.
So for example when I run the code with the above sample, F5 is set to Yes (which is correct) and F6 is also set to Yes (which not supose to happen, as the code should only run in the selection, which only contain cells in row 5).


Here is the code that I've used:

Function RandCell(Rg As Range) As Range    Set RandCell = Rg.Cells(Int(Rnd * Rg.Cells.Count) + 1)
End Function


Sub RandCellTest()
Dim Counter As Long
Dim TargetRg As Range, Cell As Range
Dim TargetRg2 As Range
Dim TestCaseCount As Variant




'Ask for the # of test cases
TestCaseCount = InputBox("Specify the number of random testcases")




'Set all testcases to "No"
Range("F5").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Value = "No"




'Set entered number of test cases to "Yes"
Range("F5").Select
Set TargetRg = Range(Selection, Selection.End(xlToRight))
For Counter = 1 To TestCaseCount
    Set Cell = RandCell(TargetRg)
    Cell.Value = "Yes"
Next


'Check if the desired number of test cases has been reached
If Range("CountTestcases2").Value < TestCaseCount Then
' If not, select all testcases put to "No"
Range("F5").Select
    Dim firstAddress As String, c As Range, rALL As Range
    With Range(Selection, Selection.End(xlToRight))
        Set c = .Find("No", LookIn:=xlValues)
        If Not c Is Nothing Then
            Set rALL = c
            firstAddress = c.Address
            Do
                Set rALL = Union(rALL, c)
                Range(c.Address).Activate
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
        .Activate
        If Not rALL Is Nothing Then rALL.Select
    End With




' Put missing number of testcases to "Yes"
TestCaseCount = TestCaseCount - Range("CountTestcases2").Value
Set TargetRg2 = Selection
For Counter = 1 To TestCaseCount
    Set Cell = RandCell(TargetRg2)
    Cell.Value = "Ja"
Next
End If


End Sub

 

[footoo]

@footoo yes in row 5, starting in column F (F5:IV5 are filled)

Try stepping through the code to see where it's failing. It's working for me.

 

[Scott T]

Is this how your data is? the code works for me. This is after the code ran with 7 inputted.

Excel 2010
	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z	AA	AB	AC	AD
5	No	No	No	No	Yes	No	No	No	No	No	Yes	No	No	No	No	No	Yes	No	Yes	No	Yes	Yes	No	No	Yes
Sheet4

 

[miicker]

Thanks for the help. The problem was that the file was saved as .XLS. Changed it to XLSM and the problem was solved. @footoo your code is still not working, only replaces the first 20, 50 or whatever number is entered.
@Scott T your code is working! It didn't work, because I changed the second NO to No, than the screen just freezes.

Eventually I went with this approach:

Eventually though, I wen't with this approach:
Private Sub CommandButton1_Click()
Dim n, Num As Long, nNum As Variant
Dim rng As Range, Dn As Range
Range("F5").Select
Set rng = Range("F5", Cells(5, Columns.Count).End(xlToLeft))
rng.Value = "No"
nNum = InputBox("Please enter the number of random test cases, this number should be between 1 and " & rng.Count - 1, "Random Fill")
If Val(nNum) > rng.Count - 1 Then
  MsgBox "Number to large, try again"
  Exit Sub
End If
If nNum > rng.Count Then
  MsgBox "Not a correct value."
  Exit Sub
End If
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
Randomize
Do Until n >= Val(nNum)
    Num = Int(Rnd * rng.Count) + 1
    If Not .Exists(Num) Then
        n = n + 1
        .Add Num, ""
      Cells(5, Num + 4) = "Yes"
End If
Loop
End With
End Sub

Because there is some error handling in it.

 

[footoo]

Just for information, here's a description of each step in the macro I posted.
Since it is based on built-in Excel tools and functions, the same result can be achieved manually without VBA (and therefore a macro could be created via the macro recorder) :

Sub RandCellTest()
Dim TestCaseCount As Variant, rng As Range
'Ask for the # of test cases
TestCaseCount = InputBox("Specify the number of random testcases")
'set current data range in row 5 starting at col F
Set rng = Range([F5], Cells(5, Columns.Count).End(xlToLeft))
'Enter "No" in all row 5 data cells
rng = "No"
'Insert 2 temporary rows
Rows("6:7").Insert
'Enter sequential numbers in row 6
[F6] = 1
[F6].AutoFill Destination:=rng.Offset(1), Type:=xlFillSeries
'Enter RAND formula in row7
rng.Offset(2).Formula = "=RAND()"
'Sort rows 6 & 7 by row 7 - This randomizes the numbers in row 6
rng.Offset(1).Resize(2).Sort Key1:=[F7], _
    Order1:=xlAscending, Header:=xlNo, Orientation:=xlLeftToRight
'Enter "Yes" the number of times obtained from the input box, starting at F5
[F5].Resize(, TestCaseCount).Formula = "Yes"
'Sort rows 5 & 6 by row 6 - This puts the "Yes" cells in their randomized sequence
rng.Resize(2).Sort Key1:=[F6], _
    Order1:=xlAscending, Header:=xlNo, Orientation:=xlLeftToRight
'Delete the temporary rows
Rows("6:7").Delete
End Sub