Random Choice

[PCRIDE]

Hi, I need to build an audit form where 10% of the records need to be flagged for the Audit. I tried using RANDBETWEEN and assigning each record with a random number between 1,10 then choosing 2 or 3 numbers and performing a VLOOKUP but the problem is everytime the sheet is calulated the numbers change.

What would be a recomendation on how to handle this? The flagged Audit records need to remain static as we will append data to this sheet daily, therfore the previous days' records need to remain. Each record also has a unique identifier.

 

[Damon Ostrander]

Hi PCRIDE,

I suggest you use a VBA/macro solution rather than a formula that recalculates. Initially you could use a macro that assigns a static random number to each of your existing records. After this is done I recommend that you implement a Worksheet_Change event that establishes a random number for each new record as it is entered. You wouldn't even have to use a random number generator for this, but could simply use, for example, the fractional seconds portion of the Timer function, which gives the number of seconds elapsed from midnight to the nearest millisecond. Since the record is presumably entered manually, the exact time it is entered is not controllable or repeatable, and is therefore essentially random, and since time progresses uniformly the numbers would be uniformly distributed, just like the RAN function.

Feel free to follow up if you need help with some code.

Damon

 

[anandvarma]

one of the trick i am using is for collecting audit sampling is conditional formatting

have look at this

Excel Workbook
	A
1	177
2	193
3	187
4	148
5	149
6	196
7	113
8	149
9	181
10	190
11	130
12	158
13	101
14	155
15	135
16	136
17	105
18	147
19	117
20	190
21	156
22	113
23	102
24	126
Sheet3

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
A1	1. / Formula is =MOD(ROW(),7)=0	Abc
A2	1. / Formula is =MOD(ROW(),7)=0	Abc
A3	1. / Formula is =MOD(ROW(),7)=0	Abc
A4	1. / Formula is =MOD(ROW(),7)=0	Abc
A5	1. / Formula is =MOD(ROW(),7)=0	Abc
A6	1. / Formula is =MOD(ROW(),7)=0	Abc
A7	1. / Formula is =MOD(ROW(),7)=0	Abc
A8	1. / Formula is =MOD(ROW(),7)=0	Abc
A9	1. / Formula is =MOD(ROW(),7)=0	Abc
A10	1. / Formula is =MOD(ROW(),7)=0	Abc
A11	1. / Formula is =MOD(ROW(),7)=0	Abc
A12	1. / Formula is =MOD(ROW(),7)=0	Abc
A13	1. / Formula is =MOD(ROW(),7)=0	Abc
A14	1. / Formula is =MOD(ROW(),7)=0	Abc
A15	1. / Formula is =MOD(ROW(),7)=0	Abc
A16	1. / Formula is =MOD(ROW(),7)=0	Abc
A17	1. / Formula is =MOD(ROW(),7)=0	Abc
A18	1. / Formula is =MOD(ROW(),7)=0	Abc
A19	1. / Formula is =MOD(ROW(),7)=0	Abc
A20	1. / Formula is =MOD(ROW(),7)=0	Abc
A21	1. / Formula is =MOD(ROW(),7)=0	Abc
A22	1. / Formula is =MOD(ROW(),7)=0	Abc
A23	1. / Formula is =MOD(ROW(),7)=0	Abc
A24	1. / Formula is =MOD(ROW(),7)=0	Abc

 

[anandvarma]

in the above example i selecting every seventh record
hope this will give you new ideas

 

[PCRIDE]

Hi, thanks for the responses. I kept searching online and found this code. Works really well!! It will copy the data and paste a % to another sheet.

Can somone help me modify this code to say

If the total count is less than or = to 20 records, copy all the records, otherwise grab 10% of the records.


Option Explicit
Sub Random20()
Randomize 'Initialize Random number seed
Dim MyRows() As Integer ' Declare dynamic array.
Dim numRows, percRows, nxtRow, nxtRnd, chkRnd, copyRow As Integer
'Determine Number of Rows in Sheet1 Column A
numRows = Sheets(4).Range("A" & Rows.Count).End(xlUp).Row
'Get 20% of that number
percRows = numRows * 0.2
'Allocate elements in Array
ReDim MyRows(percRows)
'Create Random numbers and fill array
For nxtRow = 1 To percRows
getNew:
'Generate Random number
nxtRnd = Int((numRows) * Rnd + 1)
'Loop through array, checking for Duplicates
For chkRnd = 1 To nxtRow
'Get new number if Duplicate is found
If MyRows(chkRnd) = nxtRnd Then GoTo getNew
Next
'Add element if Random number is unique
MyRows(nxtRow) = nxtRnd
Next
'Loop through Array, copying rows to Sheet2
For copyRow = 1 To percRows
Sheets(4).Rows(MyRows(copyRow)).EntireRow.Copy _
Destination:=Sheets(5).Cells(copyRow, 1)
Next
End Sub

 

[PCRIDE]

bump