List containing two columns need random assignment of values

I have a table with two columns:

Column1        Column2
Someplace1   596
Someplace2   389
Someplace3   196
.
.
.
Someplace96  983

I need to assign the values in column 2 randomly against column 1.

To clearify: I need to randomly assign each value in column 2 to the original order of values in column 1. Any suggesions or script examples would be very helpful.
Evert JorDVM/ResearcherAsked:
Who is Participating?
 
aikimarkConnect With a Mentor Commented:
@Graham

1. You shouldn't have to iterate the recordset just to get the number of records.  You can use the recordset variable's .RecordCount property.  Better yet, use the RecordCount property of the tabledef.
Example:
iRecordCount = dbEngine(0)(0).TableDefs("randomise").RecordCount
ReDim lNumbers(iRecordCount - 1)

Open in new window


==================
Rather than assume there are no zeroes and no duplicate values, you would be better off approaching this like a card deck shuffle.  In this approach, you place all the column 2 values into a collection, dictionary, or array and then pick a (pseudo-random) item from the list and delete that item. Repeat until there are no more items.

This approach would be a better performer, since you aren't worried about duplicate pseudo-random numbers.  There are other problems with VB's PRNG that I've analyzed in this article:
http:A_11114-An-Examination-of-Visual-Basic's-Random-Number-Generation.html

In this example, I'm using a collection, since adding/removing items is so simple.
Sub Q_28132078()
    Dim rs As Recordset
    Dim lngRnd As Long
    Dim colValues As New Collection
    
    Set rs = DBEngine(0)(0).OpenRecordset("randomize", dbOpenDynaset)  'use your table name
    
    'add column2 values to the collection
    Do Until rs.EOF
        colValues.Add rs.Fields("Column2").Value
        rs.MoveNext
    Loop
    
    Randomize
    
    'assign numbers from collection back to table
    rs.MoveFirst
    Do Until rs.EOF
        lngRnd = Int(Rnd * colValues.Count) + 1     'value between 1 and colvalues.count
        rs.Edit     'Update the current record with a random value
            rs.Fields("Column2").Value = colValues(lngRnd)
        rs.Update
        colValues.Remove lngRnd
        rs.MoveNext
    Loop
    
End Sub

Open in new window

0
 
GrahamSkanConnect With a Mentor RetiredCommented:
This works in tests on a small table. It assumes that there is no zero in the numbers.
Sub Reorder()
Dim rs As New ADODB.Recordset
Dim lNumbers() As Long
Dim r As Integer
Dim iRecordCount As Integer

rs.Open "randomise", CurrentProject.Connection, adOpenDynamic, adLockPessimistic

'count records and resize array
rs.MoveFirst
Do Until rs.EOF
    iRecordCount = iRecordCount + 1
    rs.MoveNext
Loop
ReDim lNumbers(iRecordCount - 1)

'put numbers into array in random order
Randomize
rs.MoveFirst
Do Until rs.EOF
    Do
        r = Int(Rnd * iRecordCount)
    Loop Until lNumbers(r) = 0
    lNumbers(r) = rs.Fields("Numbers").Value
    rs.MoveNext
Loop

'copy numbers from array to table
rs.MoveFirst
r = 0
Do Until rs.EOF
    rs.Fields("Numbers").Value = lNumbers(r)
    rs.Update
    rs.MoveNext
    r = r + 1
Loop

End Sub

Open in new window

0
 
GrahamSkanRetiredCommented:
Aikmark,
Thank you for that.
I was using ADO, it being a later technology, so the TableDef property isn't available. As you will know, the ADO RecordCount property isn't reliable. MoveLast doesn't help, so walking though the records seems to be the next best thing

From the question, assuming that zero is not a legal number seems reasonable. If it turns out that 0 is an allowbale value then pre-filling the array with a defined illegal number, such as -1 would work just as well.

EvertJor,
Please be prompt in responding to comments, otherwise you are liable to get quibbles like this between experts, which might be the source of some confusion.
0
Cloud Class® Course: CompTIA Cloud+

The CompTIA Cloud+ Basic training course will teach you about cloud concepts and models, data storage, networking, and network infrastructure.

 
aikimarkCommented:
I usually instantiate recordsets from the dbEngine(0)(0) object when I'm inside of an Access routine and querying inside the same database.  If forced to use ADO to touch an external table, you can use a "Select Count(*) From tablename" query to ascertain the number of rows.
0
 
GrahamSkanRetiredCommented:
EvertJor,

There is nothing wrong with aikimarks's contribution. It is just like goimg left, then right, as opposed to going right, then left to get to the opposite corner from the current position.

If you are confused then, as I said before, be advised to attend to your questions as soon as possible
0
 
Evert JorDVM/ResearcherAuthor Commented:
Compliments to both of you for your answers!
Actually aikimark -  it would be a problem with the data if there are duplicates and this can't be recognized....

One example would be that a new and an old part are registered in the same table with the same value. So two identical records... If one of the parts is defective and both were scanned with an x-ray machine (costly) to detect this (and it wasn't entered in the db it would be a shame not to carefully avoid the problem with identical entries ;-))
Someone pulled off the sticker saying which part was the new one...

I'm testing both solutions. Thanks again!
0
 
Evert JorDVM/ResearcherAuthor Commented:
So the field is actually a text field and not a number.
0
 
GrahamSkanRetiredCommented:
Nevertheless, is the field restricted to a numerical value?
0
 
Evert JorDVM/ResearcherAuthor Commented:
aikimark and GrahamSkan.

I'm getting "User type not defined error" on your VBA code Graham.

aikimark: Your solutions works on a simple dataset (I've not taken the duplicate-problem into account yet). I changed your code slightly to add the random values into an empty column.

Then I need to detect the duplicates beforehand - so before making the new column with the random values we need to check for duplicates and give the user a warning (better safe than...) to abort the subroutine. I could use a query to detect duplicates and then give a warning before running the code?
0
 
GrahamSkanRetiredCommented:
What is your environment OS, (Application and version)?

Perhaps your version doesn't automatically connect to ADO?
0
 
aikimarkConnect With a Mentor Commented:
You can check for duplicate values with a Group By query.
Example:
    Set rs = DBEngine(0)(0).OpenRecordset("Select Column2, Count(Column2) From randomize Group By Column2 Having Count(Column2) > 1", dbOpenDynaset)
If rs.EOF Then
Else
    intReply = Msgbox("Duplicate Column2 values detected. Click Yes to continue.", vbYesNo)
    If intReply = vbNo Then    
        'take abortive action
    End If
End If

Open in new window

0
 
GrahamSkanRetiredCommented:
For my code to work at all, there needs to be a reference (Tools/References in the VBA IDE)  to the Microsoft ActiveX Data Objects library. I thought that it was set as standard in Access these days
0
 
Evert JorDVM/ResearcherAuthor Commented:
OK, aikimark. Thanks for your suggestion regarding detecting duplicates. It works.
With regards to the left to right and right to left GrahamSkan - I do have a third column with the position ID.

Example:

Position  Numbers1            Numbers 2 (randomized)
1             Part 1                   Part 3
2             Part 2                   Part 1
3             Part 3                   Part 2
4             Part 4                   Part 4

So I always know where the parts are since I know the position they are in.
The reason for doing it that way is to have two different point to detect systematic errors in analytical systems.

Thanks to both of you for your help.
0
 
Evert JorDVM/ResearcherAuthor Commented:
My OS is Windows 8 and Access 2010.

To GrahamSkan: In the 64 bit v. of Access very few things seemed standard to me. I went from 2003 to 2010.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.