Random Number - Statistical Sample Question - Page 2
MZ Tools makes life easier for the Excel VBA coder
Thanks Thanks:  0
Likes Likes:  0
Page 2 of 2 FirstFirst 12
Results 11 to 19 of 19

Thread: Random Number - Statistical Sample Question

  1. #11
    New Member
    Join Date
    Mar 2002
    Posts
    33
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

     
    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

  2. #12
    Board Regular
    Join Date
    Mar 2002
    Location
    Cincinnati, Ohio, USA
    Posts
    6,824
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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 ]

  3. #13
    Board Regular
    Join Date
    Mar 2002
    Location
    Cincinnati, Ohio, USA
    Posts
    6,824
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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

  4. #14
    New Member
    Join Date
    Mar 2002
    Posts
    33
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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

  5. #15
    MrExcel MVP
    Join Date
    Feb 2002
    Location
    Newcastle, UK
    Posts
    1,174
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Did you get the E-mail I sent re: this problem?
    "Have a good time......all the time"
    Ian Mac

  6. #16
    New Member
    Join Date
    Mar 2002
    Posts
    33
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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

  7. #17
    Board Regular
    Join Date
    Mar 2002
    Location
    Cincinnati, Ohio, USA
    Posts
    6,824
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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 ]

  8. #18
    Board Regular
    Join Date
    Feb 2002
    Location
    Guderup, Denmark
    Posts
    288
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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

  9. #19
    MrExcel MVP
    Join Date
    Feb 2002
    Location
    Newcastle, UK
    Posts
    1,174
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

      
    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!

    "Have a good time......all the time"
    Ian Mac

User Tag List

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  

 

 
DMCA.com