Random Number - Statistical Sample Question

[Mopacs]

Hello again,

Another day, another question.....(i'm editing this post with a more concise explanation of what I intend to do..3/25):

I run a periodic "random sample" report for staff here at work. The staff has a set of providers they monitor. They require a random sampling of those provider's clients (usually between 10 and 150 clients per provider). Each client has a ID# assigned to them...from those I generate the sample.

In Column "A" I have a listing of unique client numbers (the number of client numbers will vary every time). The list always starts in cell "A17"..but that is pretty much the only constant here. The number of numbers that start at A17 can be anywhere from 10 to 150..if not more (ie, go up to cell A167 or more).

What I want to do is have a macro (or function?) dynamically select all 'filled' cells from A17 until the end of that list.. then randomly select 25% of those client numbers (ie, if there are 100 client numbers, it will randomly select 25 unique client numbers from that list), and then have the macro place those numbers into a seperate area of the worksheet (starting at cell C17).

I hope I'm not too long-winded, but any help here would be greatly appreciated! If anyone else has any suggestions here, please don't hesitate to respond.

Thanks in advance,

Rob
This message was edited by Mopacs on 2002-03-25 11:06

 

[Mopacs]

On 2002-03-25 12:39, TsTom wrote:
Hi
Paste this code in a standard module and run off of a button or from the macro menu.
Will provide 25% of total client picked randomly with no repeats and list alphabetically in row C

Place this formula in Cell AA1
=counta(AA17:AA1016)
This is to track number of clients

Let me know

Change all the references to sheet1 or change your sheet name to sheet1

Sub MopacsRandomizer()
Dim ArrayCntr As Integer
Dim ArrayUpperBound As Integer
Dim NumClients As Integer
Dim NumberKeeper()
Dim ThisRndNum As Integer
Dim AlreadyGotTheNumberBabeeee As Integer
Dim NumberKeeperCntr As Integer
Dim PutEmInRowC As Long

PutEmInRowC = 16
NumClients = Range("AA1").Value
ArrayUpperBound = Abs(NumClients / 4) + 1
ReDim NumberKeeper(1 To 1)

Do Until UBound(NumberKeeper, 1) = ArrayUpperBound
NumClients = NumClients - 1
ThisRndNum = Int(Range("AA1").Value * Rnd) + 16
AlreadyGotTheNumberBabeeee = False
For ArrayCntr = 1 To UBound(NumberKeeper, 1)
If NumberKeeper(ArrayCntr) = ThisRndNum Then
AlreadyGotTheNumberBabeeee = True
Exit For
End If
Next
If AlreadyGotTheNumberBabeeee = False Then
NumberKeeperCntr = NumberKeeperCntr + 1
ReDim Preserve NumberKeeper(1 To NumberKeeperCntr)
NumberKeeper(NumberKeeperCntr) = ThisRndNum
End If
If NumClients = 17 Then NumClients = Range("AA1").Value
Loop
PutEmInRowC = 16
For ArrayCntr = 1 To NumberKeeperCntr
PutEmInRowC = PutEmInRowC + 1
Sheet1.Range("C" & PutEmInRowC).Value = _
Sheet1.Range("A" & NumberKeeper(ArrayCntr)).Value
Next


Sheet1.Range("C17:C1016").Sort Key1:=Sheet1.Range("C17"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

Range("A17").Select
End Sub
This message was edited by TsTom on 2002-03-25 12:42

Hmm...still having some problems. The "Sheet1" reference..am I to substitute the worksheet name of the specific sheet I'm working off of? I did that, but there was a compile error.. I'm guessing the syntax used on my end was incorrect. Any further suggestions?

Thanks again,

Rob

 

[Legacy 98055]

Hi

'place this formula in AA1:
'=counta(A17:A1000)
'place all client data on A17 on down
'run macro
'YourSheet = "sheet1"
'replace sheet1 in quotes with the name
'on your sheet tab

Sub MopacsRandomizer()

Dim ArrayCntr As Integer
Dim ArrayUpperBound As Integer
Dim NumClients As Integer
Dim NumberKeeper()
Dim ThisRndNum As Integer
Dim AlreadyGotTheNumberBabeeee As Integer
Dim NumberKeeperCntr As Integer
Dim PutEmInRowC As Long
Dim YourSheet As String

'place the name which is on your sheet tab inside the quotes
'##########################
'##########################
'##
YourSheet = "sheet1" '##
'##
'##########################
'##########################


PutEmInRowC = 16
NumClients = Range("AA1").Value
ArrayUpperBound = Abs(NumClients / 4) + 1
ReDim NumberKeeper(1 To 1)

With Worksheets(YourSheet)

Do Until UBound(NumberKeeper, 1) = ArrayUpperBound

NumClients = NumClients - 1
ThisRndNum = Int(.Range("AA1").Value * Rnd) + 16
AlreadyGotTheNumberBabeeee = False

For ArrayCntr = 1 To UBound(NumberKeeper, 1)
If NumberKeeper(ArrayCntr) = ThisRndNum Then
AlreadyGotTheNumberBabeeee = True
Exit For
End If
Next

If AlreadyGotTheNumberBabeeee = False Then
NumberKeeperCntr = NumberKeeperCntr + 1
ReDim Preserve NumberKeeper(1 To NumberKeeperCntr)
NumberKeeper(NumberKeeperCntr) = ThisRndNum
End If

If NumClients = 17 Then NumClients = .Range("AA1").Value
Loop

PutEmInRowC = 16

For ArrayCntr = 1 To NumberKeeperCntr
PutEmInRowC = PutEmInRowC + 1
.Range("C" & PutEmInRowC).Value = _
.Range("A" & NumberKeeper(ArrayCntr)).Value
Next


.Range("C17:C1016").Sort Key1:=Sheet1.Range("C17"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

.Range("A17").Select

End With
End Sub
This message was edited by TsTom on 2002-03-25 17:11

 

[Legacy 98055]

Tis not a pretty piece of code, but it works
Make sure you are pasting your client list from A17 on down
Place the =counta(AA17:AA1016) in cell AA1
If you want me to mail it to you, give me an E-mail address
TsTom@hotmail.com

 

[Mopacs]

On 2002-03-25 14:46, TsTom wrote:
Tis not a pretty piece of code, but it works
Make sure you are pasting your client list from A17 on down
Place the =counta(AA17:AA1016) in cell AA1
If you want me to mail it to you, give me an E-mail address
TsTom@hotmail.com

Hey Ts,

Thanks for your assistance here. Your code seems to work..though I have a few clarifying questions:

1) In the current report I have 59 client numbers total. When I run your code I get 16 clients pulled as the "25%". There should really be closer to 15 clients pulled (25% of 59 = 14.75..there or about). If possible, is there a way we can run the sample by specifying a set number instead of a percentage. (Ie, 15 instead of saying 25%...since I will usually know that number beforehand, anyways).

2) The code seems to pull up the same numbers every time it is run. Is there a way for it to generate a different set of numbers every time the sample is run?

3) Unfortunately the "sort" at the end of the code didnt seem to work. I think its thrown off by all the 'blank' cells that appear at the bottom. I think we could use the "Offset" function here to dynamically have it find all 'filled' cells and then sort? I'm not sure though.


Well those are my observations! Thanks again for your assistance.. if you have any suggestions based on my observations above, please dont hesitate to let me know.

Thanks,

Rob

 

[Ian Mac]

Did you get the E-mail I sent re: this problem?

 

[Mopacs]

On 2002-03-26 08:04, Ian Mac wrote:
Did you get the E-mail I sent re: this problem?

Hey Ian,

Yes I am sorry... it took my blurry head a few minutes to realize you included an attachment to your email. I have since analyzed it very closely and then applied it to my spreasheet.

You put together a very complex series of formulas and conditional functions, etc... It all seem to work exactly as intended and works with my setup as well. I was hoping you wouldnt have to go through all that to come up with this..but I guess it necessitated it, so I thank you for taking your time.

I believe I understand the logic of all the functions.. though I just want to be sure this is a 'perfect' random sampling which will change every time ..and it appears to do just that. If you have a little time, could you explain a little of the logic behind your functions..such as the "RAND" and RANK and COUNTIF ..and how they all fit/work together to form this overall 'randomizer'

I understand to a degree, but I want to be sure I understand this through and through. As you can see I'm not just looking for a 'cheat' for an ends to a means! I want to completely understand the logic.

Thanks again,

Rob

 

[Legacy 98055]

Hi
Sorry, but that is the best I have to offer.
Am fairly new to Excel. It seemed to work ok. The sort should work fine irreguardless of blanks. Change this line of code to get rid of the extra 1:

ArrayUpperBound = Abs(NumClients / 4) + 1
TO:
ArrayUpperBound = Abs(NumClients / 4)

Add this word of code Randomize
right before this:
ThisRndNum = Int(.Range("AA1").Value * Rnd) + 16

Should look like th following:

Randomize
ThisRndNum = Int(.Range("AA1").Value * Rnd) + 16

There is an error here as well
I forgot to replace sheet1 with the variable YourSheet

Replace sheet1 with YourSheet and the code should work fine

Range("C17:C1016").Sort Key1:=YourSheet.Range("C17"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

Let me know...

Tom
This message was edited by TsTom on 2002-03-26 11:14

 

[Tommy Bak]

Hi
I made something like this a while ago.
Here it is, taking out 25% of the numbers on sheet1 and putting them on sheet 2. This is random and everybody is in the lottery. No numbers repeat.

Sub RandomNumbers()
Dim Number()
Dim MyRange As Range
Dim C As Range
LastNumber = Range("a17:A" & Range("A65536").End(xlUp).Row).Rows.Count
Set MyRange = Sheets(2).Range("C17:C" & (LastNumber 4) + 17)
ReDim Number(LastNumber)
For i = 1 To LastNumber
Number(i) = i
Next i
For Each C In MyRange
Placement = Int(Rnd() * LastNumber + 1)
C.Value = Sheets(1).Cells(17 + Number(Placement), 1)
dummy = Number(LastNumber)
Number(LastNumber) = Number(Placement)
Number(Placement) = dummy
LastNumber = LastNumber - 1
Next C
End Sub

regards Tommy

 

[Ian Mac]

On 2002-03-26 10:54, Mopacs wrote:

On 2002-03-26 08:04, Ian Mac wrote:
Did you get the E-mail I sent re: this problem?

Hey Ian,

Yes I am sorry... it took my blurry head a few minutes to realize you included an attachment to your email. I have since analyzed it very closely and then applied it to my spreasheet.

You put together a very complex series of formulas and conditional functions, etc... It all seem to work exactly as intended and works with my setup as well. I was hoping you wouldnt have to go through all that to come up with this..but I guess it necessitated it, so I thank you for taking your time.

I believe I understand the logic of all the functions.. though I just want to be sure this is a 'perfect' random sampling which will change every time ..and it appears to do just that. If you have a little time, could you explain a little of the logic behind your functions..such as the "RAND" and RANK and COUNTIF ..and how they all fit/work together to form this overall 'randomizer'

I understand to a degree, but I want to be sure I understand this through and through. As you can see I'm not just looking for a 'cheat' for an ends to a means! I want to completely understand the logic.

Thanks again,

Rob

The RAND() part is abviously creating a random nummber.

The RANK() place those random number in order highest to lowest being 1 to whatever. The problem being that A: the RAND() is a part of 1 i.e. 0.89889787 might be the random number:

A note: you could mulitply and round these numbers but not in the type of results you want.

B: if the number is a part of 1 it would impossible to do a look up on it (well not impossible but darn hard)

C: the more RAND()'s you have the more chance of of there being 2 the same (highly unlikely but there is a chance (that's why it's RAND() ))

SO! the RAND()/COUNTIF() uniquely identifies the number by:

Firstly: Rank the numbers, Highest to lowest.
so if you had 10 numbers it places them 1 - 10, BUT if two numbers are the same it will give them the same rank.
Secondly: using the rank number and adding the ammount of occurences of that number and minusing 1 from that.

E.g. you have the rank of 6 and there are 2 of that number it adds 2 (8) and minus 1 (7). (in the second case of that number)

Note: the COUNTIF(D$28:D28,D28) makes sure that the first 1 of the duplicate numbers return the result as if there is only 1 in the range, because as far as the formula is concerned it has because the D$28:D28 when dragged down, has only got as far as the number it's referencing and doesn't see the duplicate. SO! first instance would be RANK() = 6 + 1 (only one occurance so far) - 1 = 6.

I think that's about it. I've just spent a good five minutes looking at my answer and I hope you make more sense of it than me. (Does it answer your question?)

A BIG NOTE! The formula will ALWAYS make the first instances of a number Higher than the second (the number will be lower), third, forth etc. Unfortunatly this is the only part of if that is a constant and NOT random, if you can live with that extremely unlikely occurances of the RAND() returning the same result AND the first HAVING to be a lower number, then your OK. (It's going to happen sometime, but it's random )

Lastly, the unique RANK() formula came from Chip Pearson's excellent web site at http://www.cpearson.com . CREDIT WHERE CREDITS DUE!! thanks chip!