jeudi 30 avril 2015

VBA - create random number without duplicating

Let me start by saying I did do a search and found similar posts but I was unsure how to apply solutions to the code I have so I am hoping someone can help me.

I am trying to troubleshoot an existing Access database application that is supposed to generate a random number between 1 and the number of records in the table. This is done for 2o different tables with a varying amount of records. The tables with less records are displaying duplicate numbers of the 10 that it is supposed to display and write to a separate table. I assume the same would happen with the larger tables but with more numbers to choose from I was just unable to duplicate the issue.

Here is a sampling of the code with error handling removed:

    Dim db As DAO.Database
Dim rstRecords As DAO.Recordset
Dim rs As DAO.Recordset
Dim tdfNew As TableDef
Dim fldNew As Field
Dim i As Integer
Dim K As Integer
Dim Check As String

Set db = CurrentDb
Set rstRecords = db.OpenRecordset("customer_table")

     rstRecords.MoveLast
     FindRecordCount = rstRecords.RecordCount
     i = rstRecords.RecordCount
DoCmd.DeleteObject acTable, "Unique_numbers"

'--- create the table
Set tdfNew = db.CreateTableDef("Unique_numbers")
'--- add text field (length 20)
Set fldNew = tdfNew.CreateField("customer_table", dbLong)
'--- save the new field
tdfNew.Fields.Append fldNew

'--- save the new table design
db.TableDefs.Append tdfNew

'---Initialize your recordset
Set rs = CurrentDb.OpenRecordset("Unique_numbers", dbOpenDynaset)


'Dim i As Integer
'Dim K As Integer
'Dim Check As String

'i = TxtInput
  TxtInput = i
  K = 0
  Check = T

Do
  Do While K < 11
    'K = K + 1
        Randomize
          If K = 0 Then
            TxtOutput = Fix(i * Rnd) + 1
            rs.AddNew
            rs.Fields(0).Value = TxtOutput
            rs.Update
            K = K + 1
          ElseIf K = 1 Then
            TxtOutput2 = Fix(i * Rnd) + 1
            rs.AddNew
            rs.Fields(0).Value = TxtOutput2
            rs.Update
            K = K + 1
          ElseIf K = 2 Then
             TxtOutput3 = Fix(i * Rnd) + 1
             rs.AddNew
             rs.Fields(0).Value = TxtOutput3
             rs.Update
             K = K + 1
          ElseIf K = 3 Then
             TxtOutput4 = Fix(i * Rnd) + 1
             rs.AddNew
             rs.Fields(0).Value = TxtOutput4
             rs.Update
             K = K + 1
          ElseIf K = 4 Then
             TxtOutput5 = Fix(i * Rnd) + 1
             rs.AddNew
             rs.Fields(0).Value = TxtOutput5
             rs.Update
             K = K + 1
          ElseIf K = 5 Then
             TxtOutput6 = Fix(i * Rnd) + 1
             rs.AddNew
             rs.Fields(0).Value = TxtOutput6
             rs.Update
             K = K + 1
          ElseIf K = 6 Then
             TxtOutput7 = Fix(i * Rnd) + 1
             rs.AddNew
             rs.Fields(0).Value = TxtOutput7
             rs.Update
             K = K + 1
          ElseIf K = 7 Then
             TxtOutput8 = Fix(i * Rnd) + 1
             rs.AddNew
             rs.Fields(0).Value = TxtOutput8
             rs.Update
             K = K + 1
           ElseIf K = 8 Then
             TxtOutput9 = Fix(i * Rnd) + 1
             rs.AddNew
             rs.Fields(0).Value = TxtOutput9
             rs.Update
             K = K + 1
           ElseIf K = 9 Then
             TxtOutput10 = Fix(i * Rnd) + 1
             rs.AddNew
             rs.Fields(0).Value = TxtOutput10
             rs.Update
             K = K + 1
             Check = f
            Exit Do
          End If
    Loop
Loop Until Check = f

Thanks in advance.

Scott




Aucun commentaire:

Enregistrer un commentaire