How to assign a random number to unique records first.

[MsAxes]

I have a table that contains about 25k records of all of our customers. Each customer is identified by their internal confidential number assigned (like a social security number for each customer). Some customers have multiple records which is expected because each row they have is for a different business location.

Currently the table has about 3k unique Customer numbers that make up those 25k records I mentioned earlier.

I would like to assign a random number to all records but each unique customer number goes first.

Meaning the first 3k numbers need to be assigned to the unique Customer numbers. Then continue with the other records until all records have been counted.



Notes -the customer number is a text field.
The number of records and unique customer numbers change month to month.

[Gicu]

Create a query with a calculated field using a dCount of the Customer numbers and sort on that; the unique ones would have that as 1 so they'll be first. Set up a recordset based on that query and update the random number field. in a loop.

Cheers,

[ranman256]

paste this code into a module,
set sTBL = your table name
set your kFLD to the fieldname you want randomized
change the key field: [ClientID] to your key field.
run: RandomOrder

Public Sub RandomOrder()
Dim iTot As Long, iRec As Long
Dim iSample As Integer
Dim sTbl As String, sSql As String
Dim rst  'As Recordset
Dim i As Long
Dim iRnd As Long, lNdx As Long
Dim coll As New Collection
Dim sKey As String
  'field to fill the random#
Const kFLD = "RandomOrder"
DoCmd.SetWarnings False

sTbl = "tClients"

   'clear the order#
sSql = "update " & sTbl & " set [" & kFLD & "] = null"
DoCmd.RunSQL sSql

  'collect all keys to alter their order
Set rst = CurrentDb.OpenRecordset("select [ClientID] from " & sTbl)
With rst
   While Not .EOF
       sKey = rst.Fields("ClientID").Value & ""
       coll.Add sKey, sKey
       
       .MoveNext
   Wend
End With
Set rst = Nothing
   'pick key at random then set new order for it
i = 0
While coll.Count > 0
    i = i + 1
    iRnd = Int(coll.Count * Rnd + 1)
    'Debug.Print iRnd
    
    sKey = coll(iRnd)
    lNdx = CLng(sKey)
    sSql = "update " & sTbl & " set [" & kFLD & "] = " & i & " where [ClientID]= " & lNdx
    DoCmd.RunSQL sSql
    coll.Remove sKey
nextNum:
Wend
DoCmd.SetWarnings True
DoCmd.OpenTable sTbl
MsgBox "done"
Set coll = Nothing
Exit Sub
Resume nextNum
End Sub