Pick number of random cells in range and change value with VBA

M

miicker

Board Regular
Joined
Jun 1, 2014
Messages
75
Hi everyone,

I have an Excel sheet which is used for testing. Starting in F5 to HZ5 (so that row) cells are filled with the value "Yes" or "No". Depending on this value, the testcase is tested or not.
I want a function to put a number of random testcases to yes, and the rest to no. Keep in mind that the test cases can be expended, so HZ5, could also become ZZ5.

This is what I would like:
- The users clicks a buten like "Enable random testcases"
- The code selects row 5 (starting at column 5) ending at the last testcase, which can differ.
- All values in this range are set to "No"
- The user is prompted an input field "How many testcases do you wan't to be enabled?"
- The user enters a value (for example 20)
- The code puts 20 (or whatever the user has entered) random cells within the selection to "Yes"

I have literally no idea how to do this. I know some VBA basics, but not a lot.

Thanks in advance!
 

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand
Sort by date Sort by votes
miicker said:
Hi everyone,

I have an Excel sheet which is used for testing. Starting in F5 to HZ5 (so that row) cells are filled with the value "Yes" or "No". Depending on this value, the testcase is tested or not.
I want a function to put a number of random testcases to yes, and the rest to no. Keep in mind that the test cases can be expended, so HZ5, could also become ZZ5.

This is what I would like:
- The users clicks a buten like "Enable random testcases"
- The code selects row 5 (starting at column 5) ending at the last testcase, which can differ.
- All values in this range are set to "No"
- The user is prompted an input field "How many testcases do you wan't to be enabled?"
- The user enters a value (for example 20)
- The code puts 20 (or whatever the user has entered) random cells within the selection to "Yes"

I have literally no idea how to do this. I know some VBA basics, but not a lot.

Thanks in advance!
Click to expand...


what determines the number of tests?
 
Upvote 0
Starting at Cell F5, then shift all the way to the right. So if cell F5 contains any data there is one test case, if cell G5 contains data there are two test cases. So a simple count of cells which are not blank starting in F5 till ZZ5 or something would do the trick on calculating how many test cases there are.
 
Upvote 0
but, what determines the number of tests (what determines whether the end column is Hz or ZZ ?)
 
Upvote 0
It depends on how many test cases there are in the file. I could simply add a testcase or remove one. So basically the user decides how many test cases there are in the file.
But the number of test cases does not really matter right? There are never empty columns between test cases.
 
Upvote 0
Try this:-
NB:- "Column "E" is Column 5 !!!!
Place code in "CommandButton1_Click()" module

Code: 
Private [COLOR="Navy"]Sub[/COLOR] CommandButton1_Click()
[COLOR="Navy"]Dim[/COLOR] n, Num [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] nNum [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Set[/COLOR] Rng = Range("E5", Cells(5, Columns.Count).End(xlToLeft))
Rng.Value = "No"
nNum = InputBox("Please Enter Number between 1 an " & Rng.Count, "Random Fill")
[COLOR="Navy"]If[/COLOR] Val(nNum) > Rng.Count [COLOR="Navy"]Then[/COLOR]
  MsgBox "Number too Large, Try Again"
  [COLOR="Navy"]Exit[/COLOR] [COLOR="Navy"]Sub[/COLOR]
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]If[/COLOR] nNum > Rng.Count [COLOR="Navy"]Then[/COLOR]
  MsgBox "Not Numeric,Try Again"
  [COLOR="Navy"]Exit[/COLOR] [COLOR="Navy"]Sub[/COLOR]
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
Randomize
[COLOR="Navy"]Do[/COLOR] Until n >= Val(nNum)
    Num = Int(Rnd * Rng.Count) + 1
    [COLOR="Navy"]If[/COLOR] Not .Exists(Num) [COLOR="Navy"]Then[/COLOR]
        n = n + 1
        .Add Num, ""
      Cells(5, Num + 4) = "Yes"
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Loop[/COLOR]
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
@MickG
I could not get your code to work the way I wanted. I've created this code instead:

Code: 
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 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
End Sub

So far, so good. But because its completely random, there is a change that it puts the same cell to "Yes" multiple times. This results in not having the right amount of test cases set to "Yes". For example: when I enter 50 test cases, most of the time it only puts about 40 to yes.
How can I change this code so that it makes sure there are 50 testcases set to "Yes"?

I've tried the following (I have a named range cell where I count the number of testcases which I've put to Yes and use that in the code):
The code is used in the previous Sub.
Code: 
Dim TargetRg2 As Range
'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("Nee", 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

The code works partially, after the command "' Put missing number of testcases to "Yes"" it doesn't do anything, or sometimes even changes other random cells (not in selection) to "Yes".
How do I solve this?

Thanks in advance!
****** id="cke_pastebin" style="position: absolute; top: 1032px; width: 1px; height: 1px; overflow: hidden; left: -1000px;">' Put missing number of testcases to "Yes"</body>
 
Upvote 0
Some extra information:
I figured out that when the selection contains spaces (for example the selection is: F5, G5, H5, J5, K5, so I5 is skipped) the code shifts down a row, and puts also random cells in row 6 to "yes". If I have more skips in the selection, it shifts down even more, how do I fix this?
 
Upvote 0
MickG said:
Try this:-
NB:- "Column "E" is Column 5 !!!!
Place code in "CommandButton1_Click()" module

Code: 
Private [COLOR=Navy]Sub[/COLOR] CommandButton1_Click()
[COLOR=Navy]Dim[/COLOR] n, Num [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] nNum [COLOR=Navy]As[/COLOR] Variant
[COLOR=Navy]Dim[/COLOR] Rng [COLOR=Navy]As[/COLOR] Range, Dn [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Set[/COLOR] Rng = Range("E5", Cells(5, Columns.Count).End(xlToLeft))
Rng.Value = "No"
nNum = InputBox("Please Enter Number between 1 an " & Rng.Count, "Random Fill")
[COLOR=Navy]If[/COLOR] Val(nNum) > Rng.Count [COLOR=Navy]Then[/COLOR]
  MsgBox "Number too Large, Try Again"
  [COLOR=Navy]Exit[/COLOR] [COLOR=Navy]Sub[/COLOR]
[COLOR=Navy]End[/COLOR] If
[COLOR=Navy]If[/COLOR] nNum > Rng.Count [COLOR=Navy]Then[/COLOR]
  MsgBox "Not Numeric,Try Again"
  [COLOR=Navy]Exit[/COLOR] [COLOR=Navy]Sub[/COLOR]
[COLOR=Navy]End[/COLOR] If
[COLOR=Navy]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
Randomize
[COLOR=Navy]Do[/COLOR] Until n >= Val(nNum)
    Num = Int(Rnd * Rng.Count) + 1
    [COLOR=Navy]If[/COLOR] Not .Exists(Num) [COLOR=Navy]Then[/COLOR]
        n = n + 1
        .Add Num, ""
      Cells(5, Num + 4) = "Yes"
[COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Loop[/COLOR]
[COLOR=Navy]End[/COLOR] With
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
Regards Mick
Click to expand...

I wen't with your code eventually. I've adjusted it a bit, now it looks like this:
Code: 
Sub RandomTestCases()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))
nNum = Application.InputBox("Please enter the number of random test cases, this number should be between 1 and " & rng.Count - 1, "Random Test Cases")
If nNum = "0" Then
MsgBox "0 was entered, value should be between 1 and " & rng.Count - 1
Exit Sub
ElseIf nNum = False Then
MsgBox "Canceled"
Exit Sub
ElseIf nNum = "" Then
MsgBox "Nothing was entered, value should be between 1 and " & rng.Count - 1
Exit Sub
End If
If Val(nNum) > rng.Count - 1 Then
  MsgBox "Number to large, value should be between 1 and " & rng.Count - 1
  Exit Sub
End If
If nNum > rng.Count Then
  MsgBox "No correct value was entered, value should be between 1 and " & rng.Count - 1
  Exit Sub
End If
rng.Value = "No"
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) = "No"
End If
Loop
End With
End Sub

I've ran it several times, but sometimes (about 1 in 5 times I run the code) when I run the code it puts the entered amount to "Yes" but one. So when I enter 51, it puts in some occasions 50 cells to yes, how do I fix this?
 
Upvote 0
The "Rng" variable is described as the Range starting in "F5" to the last cell in row 5 with a value in it.
You have to fill the "Rng" values that you require before you run the code, so the code knows the set range size.
I have altered your modified code and as far as I can tell, and its working OK.
I can't see how it was working before to any degree, as you had the Value to overwrite the "No's" as " "No" instead of "Yes".
Anyway give it a try !!!

Code: 
[COLOR=navy]Sub[/COLOR] MG25Jan53
[COLOR=navy]Dim[/COLOR] rng [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] Range, nNum [COLOR=navy]As[/COLOR] [COLOR=navy]String,[/COLOR] n [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Num [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Set[/COLOR] rng = Range("F5", Cells(5, Columns.Count).End(xlToLeft))
'[COLOR=green][B]Range ("F5:BB5")[/B][/COLOR]
nNum = Application.InputBox("Please enter the number of random test cases, this number should be between 1 and " & rng.Count, "Random Test Cases")
[COLOR=navy]If[/COLOR] nNum = "0" [COLOR=navy]Then[/COLOR]
    MsgBox "0 was entered, value should be between 1 and " & rng.Count
    [COLOR=navy]Exit[/COLOR] [COLOR=navy]Sub[/COLOR]
[COLOR=navy]ElseIf[/COLOR] nNum = False [COLOR=navy]Then[/COLOR]
    MsgBox "Canceled"
    [COLOR=navy]Exit[/COLOR] [COLOR=navy]Sub[/COLOR]
[COLOR=navy]ElseIf[/COLOR] nNum = "" [COLOR=navy]Then[/COLOR]
    MsgBox "Nothing was entered, value should be between 1 and " & rng.Count - 1
    [COLOR=navy]Exit[/COLOR] [COLOR=navy]Sub[/COLOR]
[COLOR=navy]End[/COLOR] If
[COLOR=navy]If[/COLOR] Val(nNum) > rng.Count [COLOR=navy]Then[/COLOR]
  MsgBox "Number to large, value should be between 1 and " & rng.Count
  [COLOR=navy]Exit[/COLOR] [COLOR=navy]Sub[/COLOR]
[COLOR=navy]End[/COLOR] If
[COLOR=navy]If[/COLOR] nNum > rng.Count [COLOR=navy]Then[/COLOR]
  MsgBox "No correct value was entered, value should be between 1 and " & rng.Count - 1
  [COLOR=navy]Exit[/COLOR] [COLOR=navy]Sub[/COLOR]
[COLOR=navy]End[/COLOR] If
rng.Value = "No"
[COLOR=navy]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
Randomize
[COLOR=navy]Do[/COLOR] Until n >= Val(nNum)
    Num = Int(Rnd * rng.Count) + 1
    [COLOR=navy]If[/COLOR] Not .Exists(Num) [COLOR=navy]Then[/COLOR]
        n = n + 1
        .Add Num, ""
      Cells(5, Num + 5) = "Yes"
[COLOR=navy]End[/COLOR] If
[COLOR=navy]Loop[/COLOR]
[COLOR=navy]End[/COLOR] [COLOR=navy]With[/COLOR]
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]
Regards Mick
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question Question
Vba - generate random alphanumeric strings based on user input
Replies
1
Views
560
DanteAmor
DanteAmor
P
  • Solved
Copy and Re-Name Worksheet using a cell value.
Replies
3
Views
317
Logit
Logit
R
  • Solved
Msbox VBA code when cell value is changed
2
Replies
18
Views
610
Ramadan2512
R
D
  • Question Question
VBA Search a range for a value, then copy and paste data only from source to defined cells.
Replies
0
Views
100
Davion615
D
K
  • Question Question
Return a user specified number of cell values to a comma list randomly
Replies
1
Views
327
Eric W
Eric W

Forum statistics

Threads
1,224,813
Messages
6,181,117
Members
453,021
Latest member
Justyna P

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