Randomizing a Resultset 2

[CraigDolphin]

To add in another idea, since you do have text fields to work with, why not use the text string to create a numeric argument that changes with the records? Then use that in the Rnd Function....

Eg
YourSortField: Rnd(Asc(Left([TextField],1))+Asc(Right([TextField],1)))

 

[ajetrumpet]

Thanks Craig, but I'm trying to lessen the confusion here. I can use that, yes, but my process is VERY VERY long, and I don't want to change it now. I don't think I have to either.

WAYNE!!! I wonder if I'm getting closer. Take a look at the text file. That represents 15 consecutive executions of the code. Where is the error that's causing the 24th record to always come in last? The code I got from the website, and now use in the module, is this:

Randomize
  
  For i = LBound(var, 2) To UBound(var, 2)

    int1 = Int(Rnd * (UBound(var, 2) - LBound(var, 2)) + LBound(var, 2)) 
    int2 = Int(Rnd * (UBound(var, 2) - LBound(var, 2)) + LBound(var, 2))

      While int1 = int2
        int2 = Int(Rnd * (UBound(var, 2) - LBound(var, 2)) + LBound(var, 2)) 
      Wend

    For j = LBound(var, 1) To UBound(var, 1) 

      str = var(j, int1)
      var(j, int1) = var(j, int2)
      var(j, int2) = str
    
    Next j

  Next i

 

[pono1]

Can't quite figure out where things are here... I'm almost afraid to ask but can we re-seed the randomizer: Adam, can you post a complete listing of the code you are now working with? Thanks.

 

[ajetrumpet]

Adam, can you post a complete listing of the code you are now working with? Thanks.

Any code in green is prep for printing in the immediate window. Code in red is actual print code. Here it is:

Dim rs As Recordset
  Set rs = CurrentDb.OpenRecordset(Me.listtables)

  If IsNull(Me.listtables) Or IsNull(Me.txtrecordcount) Then
    MsgBox "Please fill in all the search criteria!", vbOKOnly + vbCritical, _
      "Missing Data Found"
  
  ElseIf Me.txtrecordcount > rs.RecordCount Or Me.txtrecordcount <= 0 Then
    MsgBox "The table you selected contains " & rs.RecordCount & " records." _
      & vbCr & vbCr & "Please select a valid number of records!", _
        vbCritical + vbOKOnly, "Invalid Number of Records Requested"
      
      rs.Close
    Exit Sub

  End If

Dim str As String
  Dim SQL As String
    Dim c As Control
      Dim i As Integer
        Dim j As Integer
          Dim var As Variant
            Dim int1 As Integer
              Dim int2 As Integer
                Dim intRow As Integer
                  Dim strRecord As String

Set c = Me.listfields
SQL = "SELECT "
  
  For intRow = 0 To (c.ListCount - 1)
    
    If c.Selected(intRow) Then
      SQL = SQL & Me.listtables & "." & c.Column(0, intRow) & ","
    End If
  
  Next intRow

SQL = Left(SQL, Len(SQL) - 1)
SQL = SQL & " FROM " & Me.listtables

  Set rs = CurrentDb.OpenRecordset(SQL, dbOpenDynaset)
    rs.MoveLast
    rs.MoveFirst

str = ""
  strRecord = ""
    var = rs.GetRows(rs.RecordCount)

Randomize
  
  For i = 0 To (Me.txtrecordcount - 1)

    int1 = Int(Rnd * (UBound(var, 2) - LBound(var, 2) + 1))
    int2 = Int(Rnd * (UBound(var, 2) - LBound(var, 2) + 1))

      While int1 = int2
        int2 = Int(Rnd * (UBound(var, 2) - LBound(var, 2) + 1))
      Wend

    For j = LBound(var, 1) To UBound(var, 1)

      str = var(j, int1)
      var(j, int1) = var(j, int2)
      var(j, int2) = str

    Next j

  Next i

[COLOR="Red"]Debug.Print vbCr[/COLOR]

[COLOR="SeaGreen"]For i = 0 To (Me.txtrecordcount - 1)

  For j = LBound(var, 1) To UBound(var, 1)
    strRecord = strRecord & var(j, i) & ", "
  Next j

    strRecord = Left(strRecord, Len(strRecord) - 2)
      [COLOR="Red"]Debug.Print strRecord[/COLOR]
    strRecord = ""

Next i[/COLOR]

rs.Close
Set rs = Nothing

I have attached another text file. This one shows the absolute position values of the records being returned when a user chooses to see 15 random records from the table (each column is a run of the code. It shows 15 consecutive test runs). The table that the test was done on has a total of 24 records in it.

(See any patterns?)

 

[WayneRyan]

Adam,

Just one question.

If you exit the app and re-run it, do you get the same resultset?

Wayne

 

[ajetrumpet]

No, but I am noticing a lot of the sets starting with the first record (1), but not all of them. Potential problem, you think?

 

[WayneRyan]

Adam,

Well, that's good to hear!

Can you post a sample DB?

Wayne

 

[ajetrumpet]

No, because all I have right now is the shuffled array, printing in the immediate window.

I have to write the loops now to throw the elements into a form. After I do that, I will post it up, OK?

 

[WayneRyan]

Adam,

OK, fine ... I'll be looking forward to it.

Wayne

 

[WayneRyan]

Adam,

Wow, it's been a tough week and I didn't have A2003 at home.

Here's a different way of looking at it.

Wayne

 

[ajetrumpet]

Wayne,

Thanks for the sample! I noticed that you used the Rnd() function verbatim, per the instructions in the help menu. Easy way out, huh?

I just have one gripe: You already have the query object created, and I want to avoid that.

Can you do me a favor? Try it the way I did...but I want an object created on the fly, and then deleted on close. Since you're my little helper, how about an idea for that?

 

[WayneRyan]

Adam,

Create the QueryDef?

Then delete it?

Wayne

 

[ajetrumpet]

Adam,

Create the QueryDef?

Then delete it?

Sure Wayne, you can do that, but how do you delete it when the query is closed? I need a dynamic delete. How in the world do you write that when there is no object to reference (i.e. the code has not created it yet)! Back to you...