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]

Try this :

Sub RandCellTest()
Dim TestCaseCount As Variant, rng As Range
'Ask for the # of test cases
TestCaseCount = InputBox("Specify the number of random testcases")
Set rng = Range([F5], Cells(5, Columns.Count).End(xlToLeft))
rng = "No"
Rows("6:7").Insert
[F6] = 1
[F6].AutoFill Destination:=rng.Offset(1), Type:=xlFillSeries
rng.Offset(2).Formula = "=RAND()"
rng.Offset(1).Resize(2).Sort Key1:=[F7], _
    Order1:=xlAscending, Header:=xlNo, Orientation:=xlLeftToRight
[F5].Resize(, TestCaseCount).Formula = "Yes"
rng.Resize(3).Sort Key1:=[F6], _
    Order1:=xlAscending, Header:=xlNo, Orientation:=xlLeftToRight
Rows("6:7").Delete
End Sub

 

[miicker]

@footoo thanks. I have tried the code, but it just puts the first entered number of cells in the selection to yes instead of random cells in the range. So when I enter 20, it changes the first 20 cells within the selection to "Yes", I need random cells within the selection put to "Yes"

 

[Scott T]

try

If the entered number is greater then the number of cells available I assume all should be yes.

Sub RandCell()
Dim lc As Long
Dim rng As Range
lc = Cells(5, Columns.Count).End(xlToLeft).Column
Set rng = Range(Cells(5, 6), Cells(5, lc))
rng = "No"
yesnum = InputBox("Specify the number of random testcases")
numcell = rng.Count
If yesnum + 0 >= numcell Then
    rng = "Yes"
    Exit Sub
End If
Do Until x = yesnum + 0
    y = Application.RandBetween(1, numcell)
    If UCase(Cells(5, y + 5)) = "NO" Then
        Cells(5, y + 5) = "Yes"
        x = x + 1
    End If
Loop

End Sub

 

[footoo]

@footoo thanks. I have tried the code, but it just puts the first entered number of cells in the selection to yes instead of random cells in the range. So when I enter 20, it changes the first 20 cells within the selection to "Yes", I need random cells within the selection put to "Yes"

Are there more than 20 cells to start with?
I've tested the macro and it works for me.

 

[miicker]

@Scott T this code just freezes an crashes my Excel...

 

[miicker]

Are there more than 20 cells to start with?
I've tested the macro and it works for me.

Yes, there are over 250 cells.

 

[footoo]

Yes, there are over 250 cells.

In row 5 ?

 

[Scott T]

Did you run the code before the edit? If so try again.

 

[miicker]

@footoo yes in row 5, starting in column F (F5:IV5 are filled) @Scott T the code now runs, but only puts the first cell within the selection to "Yes", the rest stays on "No"