Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

"Randomize" 2

Status
Not open for further replies.

Pmack

Technical User
Oct 24, 2000
1
US
Hello,

I am fairly new to VBA programming in Access, but have a background in Pascal / Basic .. Ok, ok, I haven't programmed in a while.

Anyways, is there any way to duplicate a Random or Randomize function? More specifically, I am looking to randomly select a random number out of one query, and port them to a table.

In other words, having performed an initial query, is there some function, or code snippet that will randomly select say 10 records out of the query and port them to a table?

Thanks in advance for any help.

Patrick Mack
Pat_Mack@jeffersonwells.com
 
OK, it's not pretty, but this is what I come up with.

You could open a recordset based on the query. Then you would use the Randomize Statement and the Rnd function to get 10 random numbers which range from 1 to your recordset's recordcount. Use those random numbers to choose your records.

Does that sound like what you are aiming for?

Kathryn


 
Patrick, Kathryn

I see some 'issues' in the ALL SQL/Query approach. Rather than go through the litany of whining, I thought I'd post some sample code for the process.

Of couorse, Patrick et al will need to revise to reflect the appropiate table/filed names for the recordsets, but then this is more for illustration than production, so there may be A LOT of un-necessary stuff in the function.

Comment on/revise to suit?



MichaelRed
mred@duvallgroup.com
There is never time to do it right but there is always time to do it over
 
I must have scrolled right past the sample code, or something. :) Will you be revisiting this thread with that aforementioned function, [COLOR=660000]MichaelRed[/color]? I'd sure appreciate the assistance.
 
I have a sample db that allows random record selection that I am sending you. Hope it helps, if anyone else wants to see it drop me a line. Joe Miller
joe.miller@flotech.net
 
Where in the world did THIS come from? LAST OCT? It is AT LEAST THREE jobs ago - and no one ever 'dinged' me before? What a forgiving CROWD. I should do stand up comedy here!

I need to get a few thing done before I can "un=Archive" this, I WILL respond tomorrow, unless you re-post to say it is not necessary.

MichaelRed
mred@att.net

There is never time to do it right but there is always time to do it over
 
O.K. - Cogito ergo TEST it CAREFULLY!. It does work - but you may wnat to change bits (bytes) and other pieces.


Code:
Public Function basRndRecs(RecSet As String)

    'Need to get a random number of RANDOM records from a recordset

    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim qdf As QueryDef

    Dim RecCnt As Long      'HOW many are available
    Dim NRecs As Long       'How many we Will Return
    Dim Idx As Long         'Just another  index
    Dim Jdx As Long         'And One more (index) fior the road?
    Dim tmpRecNum As Long   'Trial Record Number to Add to "List"
    Dim RecNums() As Long   'Actual Records (Ordinal Position)
    Dim strSql As String    'A mechanisim to create the "Random RecordSet"

    On Error GoTo ErrExit

    Set dbs = CurrentDb
    Set rst = dbs.OpenRecordset(RecSet, dbOpenDynaset)

    'First, Get the RecordCount
    rst.MoveLast
    rst.MoveFirst
    RecCnt = rst.RecordCount

    NRecs = CLng(Rnd() * RecCnt)
    'This would be the place to LIMIT (both Hi and Lo!)
    'the number or Percentage of Records to Return
    'Here, I'll use 10% for the Low and 35% for the High.
    'substitute your desired percentages or change to Absoloute Numbers
    
    If (NRecs > 0.35 * RecCnt) Then
        NRecs = CLng(0.35 * RecCnt)
    End If
    
    If (NRecs < 0.1 * RecCnt) Then
        NRecs = CLng(0.1 * RecCnt)
    End If
    
    'Get the proposed records to Return
    ReDim RecNums(NRecs)        'Make it the &quot;correct size
    For Idx = 1 To NRecs
        RecNums(Idx) = CLng((Rnd() * RecCnt) + 1)
    Next Idx

    'Remove Duplicates from Proposed.  In theory, this could 'upset' the
    'number / percentage of records returned.  Since we are supposed to
    'return a RANDOM # of record, Who would know?
    For Idx = 0 To UBound(RecNums) - 1
        For Jdx = Idx + 1 To UBound(RecNums)
            If (RecNums(Jdx) = RecNums(Idx)) Then
                'Houston, we have a problem Here.
                'Set the Record Number to &quot;Invalid&quot;
                RecNums(Jdx) = -1
            End If
        Next Jdx
    Next Idx

    'Need to Delete the temp Table - If it Exists
    DoCmd.DeleteObject acTable, RecSet & &quot;Temp&quot;
    

    'Now, create a temp recordset with from the original recordset
    'Here, I'll use a make table query, as it always create SOME recordset
    strSql = &quot;Select &quot; & RecSet & &quot;.*, 0 as RecSel Into &quot; & RecSet & &quot;Temp&quot; & &quot; &quot;
    strSql = strSql & &quot;From &quot; & RecSet & &quot;;&quot;

    Set qdf = dbs.CreateQueryDef(&quot;&quot;, strSql)
    qdf.Execute
    'strSql.Execute 'strSql

    Set rst = dbs.OpenRecordset(RecSet & &quot;Temp&quot;, dbOpenDynaset)
    With rst
        .MoveLast
        .MoveFirst
        For Idx = 0 To UBound(RecNums)
            If (RecNums(Idx) > 0) Then
                .AbsolutePosition = RecNums(Idx)
                .Edit
                    !RecSel = Idx
                .Update
            End If
        Next Idx
    End With
        
    strSql = &quot;Delete * From &quot; & RecSet & &quot;Temp Where RecSel = 0;&quot;
    Set qdf = dbs.CreateQueryDef(&quot;&quot;, strSql)
    qdf.Execute

    'Here.  The 'original Record set has been &quot;Cloned&quot;, and a random number
    'of randomly selected records has been retained, with all others deleted.


ErrExit:
    If (Err = 7874) Then        'Object Not found
        Resume Next
    End If

End Function
MichaelRed
mred@att.net

There is never time to do it right but there is always time to do it over
 
Wow, thanks. That wasn't what I was looking for, but now I know in completest detail that it wasn't what I was looking for. :)

David
 
O.K. what was it that you DID want?

I remember who/what/when/why/where would want this and I could only guess that it was for (mis-giuded?) Q.A. attempt, or a way to generate a &quot;Sample&quot; data set for test and Debug purposes. I rembered it all over again when I dug this out and had to review it for use in ver 2K (had to add the &quot;DAO.&quot; - but couldn't remember how many places / where. ended up with a few less declarations just to limit them.

Still wondering, but now HAVE 2 questions. For the above and what you THOUGHT you wanted (or was it really wanted?).

MichaelRed
mred@att.net

There is never time to do it right but there is always time to do it over
 
Misguided q:a attempt, yes ... sorry to take up your time. I'm in the midst of a ColdFusion project right now, in which I wanted to randomly pull a few records out of an Access table for display. I now realize this was probably a question for the SQL or CF forums [and I've now also found a more concise solution in the CFML function reference with the RandRange() function]. I hadn't originally found much mention of it in the other forums, though, and thought the Access forum might be the place. Since you hadn't posted your code, I merely guessed at its applicability to my search.

Thanks anyway, and my apologies again.
 
Well, DOESN'T it pull a random number of records from a table (and place them into a 'new' table)?

MichaelRed
mred@att.net

There is never time to do it right but there is always time to do it over
 
Yes, but I don't need a random number of records, I just need a specific number of random records. And I don't need a new table in Access, I need the records to be pulled up into a CFML page.

It'll just be much, much simpler for me to do that using CF's RandRange(), rather than setting it up in Access.

Your solution is great, just way more than I need. Perhaps it'll useful to someone else.

Thanks again
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top