Solved

# List containing two columns need random assignment of values

Posted on 2013-05-17
449 Views
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.
0
Question by:EvertJor
• 6
• 5
• 3

LVL 76

Assisted Solution

GrahamSkan earned 100 total points
This works in tests on a small table. It assumes that there is no zero in the numbers.
``````Sub Reorder()
Dim lNumbers() As Long
Dim r As Integer
Dim iRecordCount As Integer

'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
``````
0

LVL 45

Accepted Solution

aikimark earned 400 total points
@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)
``````

==================
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
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
``````
0

LVL 76

Expert Comment

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

LVL 45

Expert Comment

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

LVL 76

Expert Comment

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

Author Comment

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

Author Comment

So the field is actually a text field and not a number.
0

LVL 76

Expert Comment

Nevertheless, is the field restricted to a numerical value?
0

Author Comment

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

LVL 76

Expert Comment

What is your environment OS, (Application and version)?

0

LVL 45

Assisted Solution

aikimark earned 400 total points
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)
'take abortive action
End If
End If
``````
0

LVL 76

Expert Comment

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

Author Comment

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

Author Closing Comment

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

## Featured Post

### Suggested Solutions

INTRODUCTION The purpose of this document is to demonstrate the Installation and configuration of the Data Protection Manager product. Note that this demonstration was prepared on the basis of Windows OS is 2008 R2 and DPM 2010. DATA PROTECTI…
The password reset disk is often mentioned as the best solution to deal with the lost Windows password problem. In Windows 2008, 7, Vista and XP, a password reset disk can be easily created. But besides Windows 7/Vista/XP, Windows Server 2008 and ot…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…