Page 1 of 3 123 LastLast
Results 1 to 15 of 44
  1. #1
    Join Date
    Jul 2003
    Posts
    292

    Unanswered: random testing......plz help

    I have a database which picks out random employees (5) to test from different departments throughout the company. Each employee gets picked, time stamped today's date and time stamped again with a date two years from today.

    ( When an employee gets picked he/she will not get picked again for 2 years )

    This part I have done..

    What I want now is .. for each employee picked I do not want them to have the same supervisor. I can't have a random pick with say 3 of the 5 employee from 1 department tested at one time.. that would leave only 2 employee to work in that department.. and that is not good..


    I been working on this code with a friend.. and we are stumped... We run the code and its picks out 5 employees .. clear the table run the code again.. then we get a duplicate supervisor.. !

    Could someone look at the code and tell me what we done wrong ?? thanks a bunch for your help.. it is appreciated...


    the code
    ========


    Private Sub Command0_Click()
    On Error GoTo Err_Command0_Click
    Dim intRnd, intRndHi, intRndLo As Integer
    Dim strsql, strCurrent As String

    strCurrent = Date
    MsgBox "Press OK to Select Employee"
    str1SupervisorName = "Doe, John"
    str2SupervisorName = "Doe, John"
    str3SupervisorName = "Doe, John"
    str4SupervisorName = "Doe, John"
    str5SupervisorName = "Doe, John"


    For i = 1 To 5
    Me.RecordSource = "SELECT COUNT ([EmpName]) AS NoName FROM Table1 WHERE [NextTestDate] < #" & strCurrent & "# OR ISNULL([Tested]);"
    If Me![NoName] = 0 Then
    MsgBox "Warning! No Records Selected!"
    Exit Sub
    Else
    intRndLo = 1
    intRndHi = Me![NoName]
    intRnd = Int((intRndHi - intRndLo + 1) * Rnd + intRndLo)
    strsql = "SELECT * FROM Table1 WHERE [NextTestDate] < #" & strCurrent & "# OR ISNULL([Tested]) " & strCondition & " ORDER BY [EmpName];"
    Me.RecordSource = strsql
    DoCmd.GoToRecord acDataForm, "frmRandom", acGoTo, intRnd
    Me![Tested] = Format(Date, "Short Date")
    Me![NextTestDate] = DateAdd("yyyy", 2, Me![Tested])
    Me.Refresh

    End If
    DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70

    Select Case i

    ///////////// This is where I have supervisors Name checked /////////////////
    Case 2
    str2SupervisorName = Me![Supervisor]
    strCondition = "AND ([Supervisor] <> " & "'" & str2SupervisorName & "')"

    Case 3
    str3SupervisorName = Me![Supervisor]
    strCondition = "AND ([Supervisor] <> " & "'" & str2SupervisorName & "'" & " OR [Supervisor] <> " & "'" & str3SupervisorName & "')"

    Case 4
    str4SupervisorName = Me![Supervisor]
    strCondition = "AND ([Supervisor] <> " & "'" & str2SupervisorName & "'" & " OR [Supervisor] <> " & "'" & str3SupervisorName & "'" & _
    " OR [Supervisor] <> " & "'" & str4SupervisorName & "')"

    Case 5
    str5SupervisorName = Me![Supervisor]
    strCondition = "AND ([Supervisor] <> " & "'" & str2SupervisorName & "'" & " OR [Supervisor] <> " & "'" & str3SupervisorName & "'" & _
    " OR [Supervisor] <> " & "'" & str4SupervisorName & "'" & " OR [Supervisor] <> " & "'" & str5SupervisorName & "')"

    Case Else
    End Select
    Next i
    MsgBox "Employees Selected! Click VIEW REPORT to view employees"
    Command33_Click
    Exit_Command0_Click:
    Exit Sub

    Err_Command0_Click:
    MsgBox Err.Description
    Resume Exit_Command0_Click

    intRnd = ""
    intRndHi = ""
    intRndLo = ""
    str1SupervisorName = "Doe, John"
    str2SupervisorName = "Doe, John"
    str3SupervisorName = "Doe, John"
    str4SupervisorName = "Doe, John"
    str5SupervisorName = "Doe, John"

    End Sub





    again thanks for your time

  2. #2
    Join Date
    Jul 2003
    Posts
    292

    help

    someone suggested that I do this....

    I would approach this in a completely different way.
    I'd have code that did a random search though the table to find the first employee who is in the appropriate date range. Save that employee ID, Name, Supervisor and Department in a temporary table. Now do a random search for random employee number 2 - if they have different Supervisor, Department (and are not the same employee) select him/her and save in the table as before, if not look for the next one. Stop when you hit the number you need and create your report.
    Whatever method you use, you must take obviously care that your criteria allow you to find 5 hits among the remaining employees.


    Although this does sound better.. I might have failed to mention that I'm really new to access and VB coding.. soo I'm at an utter lost..

    could anyone guide me in the right direction...


    thanks so much

  3. #3
    Join Date
    May 2002
    Location
    London
    Posts
    87
    Latest version.

    This runs independant of any form.
    There are no checks if we run out of employees to test.



    Public Sub Pick5()

    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim lngPick as Long
    Dim intCount as Integer
    Dim strSQL as String


    Set dbs = CurrentDb()

    'Our base SQL to select eligible employees

    strsql = "SELECT * FROM Table1 WHERE (([NextTestDate] < #" & strCurrent & "#) OR ISNULL([Tested])) "



    For intCount = 1 to 5

    '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

    'Now add a condition to the SQL that next time itexcludes all employees with the selected Supervisor
    strSQL = strSQL & " AND (Super<>'" & rst!Super & "')"

    With rst
    .edit
    !Tested = (Date, "Short Date")
    !NextTestDate = DateAdd("yyyy", 2, Me![Tested])
    .update
    .close
    end with

    'Loop and run the process again with only the remaining available employees.
    Next
    End Sub
    Last edited by Risky; 08-05-03 at 12:49.

  4. #4
    Join Date
    Jul 2003
    Posts
    292

    Smile

    could you explain your code in detail.. I'm sorry

    newb here

  5. #5
    Join Date
    Jul 2003
    Posts
    292

    Smile

    could you explain your code in detail.. I'm sorry

    newb here

  6. #6
    Join Date
    May 2002
    Location
    London
    Posts
    87
    I've put a few comments in. Of course you need to sort ot the SQL for your employee data yourself, but then I don't know what you want as output.

    Let me know where I'm being unclear.

  7. #7
    Join Date
    Jul 2003
    Posts
    292
    Where would this section of the code go into.. The section of my code on top... where whenever an employee gets picked .. the employee is time stamped.. with todays date "Tested" and todays date +2 years "NextTestDate" is needed. I dont know where it should be placed in your code..

    also, in your code wat is... "start" and "finish"

    I have included my table for you to look at... if looking at the db itself would help.. let me know .. I can send you a copy if you would like to see..

    heres my table..

    "Table1" ( This is where all info on employees are kept)

    Payroll
    Shift
    EmpName
    Supervisor
    SuperExt
    Department
    Division
    Tested
    NextTestDate
    UpdatedBy

    All are Text Except for "Tested" and "NextTestDate"




    Thanks

  8. #8
    Join Date
    May 2002
    Location
    London
    Posts
    87
    Ok The code is fairly explicit now.

    Its as a subroutine that just updates the table with the dates for five random employees.

    You can sort out the output yourself once the 5 are picked.

  9. #9
    Join Date
    Jul 2003
    Posts
    292
    Risky,

    *New Error* Errrgh

    Run-Time error '2465'

    Microsoft Access can't find the field "Tested" referred to in your expression...

    I double checked and I do have the field "Tested" in my Table1.. Data type is = Date/Time


    The line that comes back highlighted is in code <~~

    Option Compare Database
    Option Explicit
    Private Sub Command0_Click()
    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()

    'Our base SQL to select eligible employees

    strSQL = "SELECT * FROM Table1 WHERE (([NextTestDate] < #" & strCurrent & "#) OR ISNULL([Tested])) "



    For intCount = 1 To 5

    '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

    'Now add a condition to the SQL that next time itexcludes all employees with the selected Supervisor
    strSQL = strSQL & " AND (Supervisor<>'" & rst!Supervisor & "')"

    With rst
    .Edit
    !Tested = Format(Date, "Short Date")
    !NextTestDate = DateAdd("yyyy", 2, Me![Tested]) <~~ HIGHLIGHTED
    .Update
    .Close
    End With

    'Loop and run the process again with only the remaining available employees.
    Next
    End Sub


    Thanks
    Last edited by TonyT; 08-06-03 at 11:42.

  10. #10
    Join Date
    May 2002
    Location
    London
    Posts
    87
    Oops, that was taken from your original. I haven't declared or set strCurrent. How about changing strCurrent to"Format(Date,"dd-mmm-yyyy")

    Oh and stick

    Option Explicit at the top of the module if its not there, then such a problem would be picked up on compile, I think.

  11. #11
    Join Date
    Jul 2003
    Posts
    292
    I made the changes .. still coming up with an error.. something about "Tested" not found... I have edited the code above..

    Update on my first code..
    ============================================

    Select Case i
    Case 1
    str2SupervisorName = Me![Department]
    strCondition = "AND ([Department] <> " & "'" & str2SupervisorName & "')"
    Case 2
    str3SupervisorName = Me![Department]
    strCondition = "AND ([Department] <> " & "'" & str2SupervisorName & "'" & " AND [Department] <> " & "'" & str3SupervisorName & "')"
    Case 3
    str4SupervisorName = Me![Department]
    strCondition = "AND ([Department] <> " & "'" & str2SupervisorName & "'" & " AND [Department] <> " & "'" & str3SupervisorName & "'" & _
    " AND [Department] <> " & "'" & str4SupervisorName & "')"
    Case 4
    str5SupervisorName = Me![Department]
    strCondition = "AND ([Department] <> " & "'" & str2SupervisorName & "'" & " AND [Department] <> " & "'" & str3SupervisorName & "'" & _
    " AND [Department] <> " & "'" & str4SupervisorName & "'" & " AND [Department] <> " & "'" & str5SupervisorName & "')"
    Case 5
    str6SupervisorName = Me![Department]
    strCondition = "AND ([Department] <> " & "'" & str2SupervisorName & "'" & " AND [Department] <> " & "'" & str3SupervisorName & "'" & _
    " AND [Department] <> " & "'" & str4SupervisorName & "'" & " AND [Department] <> " & "'" & str5SupervisorName & "'" & _
    " AND [Department] <> " & "'" & str6SupervisorName & "')"

    Case Else
    End Select
    Next i

    =============================================


    I Changed all the "OR" or "AND" .. although this did pick out unique supervors name.. it did not pick all 5 on 1 run... It would pick out 2.. then gives an error... "Can't go to specified Record"

    I'm thinking it is not looping in the program.. but i don't know why not..

    If you have thoughts on this .. that would be great also...


    -I appreciate all your help...

  12. #12
    Join Date
    Dec 2002
    Location
    Préverenges, Switzerland
    Posts
    3,740
    your Next i at the end looks a bit lost! are you missing a for somewhere?

    worse: if you have a for i = 1 to something........next loop and you stick a select case i in it, you are going to get Case 1 in the first loop, Case 2 in the second loop, etc independent of any data.

    izy

  13. #13
    Join Date
    Jul 2003
    Posts
    292

    Thanks !

    I have re-did the code.. and put in arrays.. easier to read... I'm finding out that I am having problems in the SELECT stmts.. I think this is where my code is going wrong..

    I got the code to run.. finally... but its not doing what i want it to do.. which is.. to randomly pick 10 employees.. with different supervisor last names..

    I'm not to familiar with VB or access.. what i learn is through forums.. which i have learned alot.. If you or anyone could help me .. this would be great..

    thanks

    updated code
    ==============================================

    Private Sub Command0_Click()
    On Error GoTo Err_Command0_Click
    Dim intRnd As Integer, intRndHi As Integer, intRndLo As Integer
    Dim strsql As String, strCurrent As String

    ' Create an Array for Supervisor Names
    Dim strSupervisorName(10) As String
    Dim idx As Integer

    Dim lpBuff As String * 25 ' Set Up NTUSER NAME
    Dim UserNameLong As Long ' Set Up NTUSER NAME
    Dim NTUserName As String ' Set Up NTUSER NAME
    UserNameLong = GetUserName(lpBuff, 25) ' Set Up NTUSER NAME
    NTUserName = Left(lpBuff, InStr(lpBuff, Chr(0)) - 1) ' Set Up NTUSER NAME
    NTUserName = "" & NTUserName ' Set Up NTUSER NAME
    strCurrent = Date
    MsgBox "Press OK to Select Employee"

    For idx = 1 To 10
    strSupervisorName(idx) = "Doe, John"
    Next idx

    For i = 1 To 10

    ' The following query is going get the number of records in the table without Departmental restrictions.

    Me.RecordSource = "SELECT COUNT ([EmpName]) AS NoName FROM Table1 WHERE [NextTestDate] < #" & strCurrent & "# OR ISNULL([Tested]);"

    ' Shouldn't the Departmental restrictions be part of this query?

    If Me![NoName] = 0 Then
    MsgBox "Warning! No Records Selected!"
    Exit Sub
    Else
    intRndLo = 1
    intRndHi = Me![NoName]
    intRnd = Int((intRndHi - intRndLo + 1) * Rnd + intRndLo)

    ' The following query is going get the number of records in the table with Departmental restrictions. The number of records returned by this query will not be the same as the Count from the previous query because this query is further restricted by the Department.

    strsql = "SELECT * FROM Table1 WHERE [NextTestDate] < #" & strCurrent & "# OR ISNULL([Tested]) " & strCondition & " ORDER BY [EmpName];"
    Me.RecordSource = strsql

    ' Since intRnd was calculated using the Count from the unrestriced query, you could be going to a record that does not exist from the restricted query.

    DoCmd.GoToRecord acDataForm, "frmRandom", acGoTo, intRnd
    Me![Tested] = Format(Date, "Short Date")
    Me![NextTestDate] = DateAdd("yyyy", 2, Me![Tested])
    Me![UpdatedBy] = NTUserName ' Set Up NTUSER NAME
    Me.Refresh
    'SendToTextBox
    End If
    DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70

    ' Replace the Entire case statement with the following simple loop

    strCondition = ""
    For idx = 1 To i
    strCondition = strCondition & " AND [Department] <> '" & strSupervisorName(idx) & "'"
    Next idx

    Next i
    MsgBox "Employees Selected! Click VIEW REPORT to view employees"
    Command33_Click
    Exit_Command0_Click:
    Exit Sub

    Err_Command0_Click:
    MsgBox Err.Description
    Resume Exit_Command0_Click

    intRnd = ""
    intRndHi = ""
    intRndLo = ""

    For idx = 1 To 10
    strSupervisorName(idx) = "Doe, John"
    Next idx

    End Sub

  14. #14
    Join Date
    Dec 2002
    Location
    Préverenges, Switzerland
    Posts
    3,740
    just thinking...

    start with qryPlusRnd - a table or query that includes employee ID, supervisor ID, and a "random" number WHERE the two year criteria is met ORDER BY random number


    dim hitSupers(10) as long

    private someSub()
    dim dabs as dao.database
    dim recs as dao.recordset
    dim thisSuper as long
    dim gotSupers as integer
    dim loupe as integer

    for loupe = 0 to 9
    gotSupers = 0 'yes, i'm being pedantic
    next

    set dabs = currentdb
    set recs = dabs.openrecordset("qryPlusRnd")

    with recs
    .movefirst

    do while not .eof
    thisSuper = !superID ' or whatever the supervisor ID is called

    if not alreadyHit(thisSuper, gotSupers) then
    hitSupers(gotSupers) = thisSuper
    gotSupers = gotSupers + 1
    endif

    if gotSupers > 9 then exit loop 'maybe this should be "exit do" - i forget)
    .movenext
    loop

    end with

    if gotSupers > 9 then
    msgbox "Cool"
    else
    msgbox "cant find enough candidates"
    endif
    end someSub

    private function alreadyHit(which as long, already as integer) as boolean
    dim loupe as integer
    alreadyHit = false 'pedantry again
    for loupe = 0 to already-1)
    if hitSupers(loupe) = which then alreadyHit = true
    next
    end function

    izy
    Last edited by izyrider; 08-06-03 at 15:46.

  15. #15
    Join Date
    Jul 2003
    Posts
    292
    I think you may have confused me even more now =/

    sorry I'm new and slow...

Posting Permissions

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