Results 1 to 2 of 2
  1. #1
    Join Date
    Jul 2003
    Posts
    292

    Unanswered: random 2 year testing..

    Hi,

    I have an access database which randomly selects employeeS to get tested.. within 2 years.. say that i pick 40 employees.. those 40 employees will not get tested again.. till 2 years later..

    My first problem was each employee that was randomly picked had to have different supervisor. for example.. I randomly picked out 40 employees to get tested.. each of those 40 employees had to have different supervisors.

    after much help within this forum I was able to complete that... thank you very much...

    Now I have another question..

    After 18 months of testing.. the user wants to know how many employees are left that have not been tested ... these are employees within the 2 year frame..

    say that i have 900 employees i run my program and on the 18th month there should have been 720 employees tested already.. which leaves 180 employees not tested.. The user wants the number 180.. how would i do this... ??

    note:

    900 employees is not a definite number.. due to the fact that employees get hired and fired everyday.. this number may change at anytime...

    I've posted code here.. for you to take a look... thanks..


    ==============================================
    Code:
    Public Sub GetEmployees(intNoForTest As Integer, dteTestDate As Date)
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim lngPick As Long
    Dim intCount As Integer
    Dim strSQL As String
    Dim strCurrent As String
    
    strCurrent = Format(Date, "dd-mmm-yyyy")
    Set dbs = CurrentDb()
    
    Select Case MsgBox("Do you want to random test DuPont employees?" & vbCrLf & vbLf & "  Yes:         Test Employees" & vbCrLf & "  No:          Does NOT Test Employees" & vbCrLf, vbYesNo + vbQuestion, "Test DUPONT Employees?")
            Case vbYes: 'Save the changes
    
            'First lets check how many supervisors with testable employees there are
                
                strSQL = "SELECT DISTINCT Supervisor FROM Table1 WHERE (([NextTestDate] < #" & Format(dteTestDate, "dd-mmm-yyyy") & "#) OR ISNULL([Tested])) "
                Set rst = dbs.OpenRecordset(strSQL)
                If rst.EOF Then
                    'No employees to test
                    intNoForTest = 0
                Else
                    rst.MoveLast
                    If rst.RecordCount < intNoForTest Then
                        'Not enough employees so reduce number
                        intNoForTest = rst.RecordCount
                    End If
                End If
    
            'Our base SQL to select eligible employees without and supervisor restrictions
                
                strSQL = "SELECT * FROM Table1 WHERE (([NextTestDate] < #" & Format(dteTestDate, "dd-mmm-yyyy") & "#) OR ISNULL([Tested])) "
                For intCount = 1 To intNoForTest
    
            'Open a recordset for the available employees
                
                Set rst = dbs.OpenRecordset(strSQL)
                rst.MoveLast 'Move last so we know the number of records available
                rst.MoveFirst 'Move first as we will start at No 1
                ' Rnd() is >=0 , <1 so rnd*RecordCount will be >=0 and <RecordCount
                'Fix this to get an integer in range from 0 to recordcount-1
                '(drops decimals, rather than rounds)
                lngPick = Fix((rst.RecordCount) * Rnd())
    
                'move forward the selected random number of records
                
                rst.Move lngPick
                Debug.Print rst!EmpName
    
                'Now add a condition to the SQL that next time itexcludes all employees with the selected Supervisor
                
                strSQL = strSQL & " AND ((Table1.Supervisor)<>""" & rst!Supervisor & """)"
                With rst
                    .Edit
                    !Tested = Format(Date, "Short Date")
                    !NextTestDate = DateAdd("yyyy", 2, dteTestDate)
                    .Update
                    .Close
                End With
    
                'Loop and run the process again with only the remaining available employees.
                Next
                
                Command33_Click 'Opens the Query
            
            Case vbNo: 'Do not save or undo
                'Do nothing
            
            Case Else: 'Default case to trap any errors
                'Do nothing
    
    End Select
    
    Exit_GetEmployees:
        Exit Sub
    
    End Sub
    
    
    ===============================
    
    Private Sub Command0_Click()
    GetEmployees 39, Date
    Me.Requery
    End Sub

    Thank you so much for your time..

  2. #2
    Join Date
    Jul 2003
    Posts
    292
    anyone plz.. thanks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •