Select top 2 based on dynamic criteria

  • Any idea on the code necessary to pull the top 2 distinct records, based on two date fields sorted datefield 1, datefield 2, for days of the week 1 to 5 and then if days of the week are 6 to 7 pull the top 3 values?

  • nvrwrkn2 (3/11/2010)


    Any idea on the code necessary to pull the top 2 distinct records, based on two date fields sorted datefield 1, datefield 2, for days of the week 1 to 5 and then if days of the week are 6 to 7 pull the top 3 values?

    It sounds fairly trivial. Can you post some sample data and an example of what you expect as output from it? Instructions are in the link in my sig.

    β€œWrite the query the simplest way. If through testing it becomes clear that the performance is inadequate, consider alternative query forms.” - Gail Shaw

    For fast, accurate and documented assistance in answering your questions, please read this article.
    Understanding and using APPLY, (I) and (II) Paul White
    Hidden RBAR: Triangular Joins / The "Numbers" or "Tally" Table: What it is and how it replaces a loop Jeff Moden

  • taking a break... I'm tryin' to do as much of this as I can without bothering you guys to design specific code for me.

    I now have two modules, one that pulls the distinct top 2 and the other pulls the distinct top 3.

    Trying to cipher how to invoke either of the FindTop2 module when the record's Dayofweek is 1 to 5 and the FindTop3 module when the record's Dayofweek is 6 or 7.

    I'm getting there....

    between the web and my PL/SQL book I have the code for each function, just not the necessary code to put it all together... gonna look into expression builder and see if I'll get legit output from that.

  • Ok, still a bit stymied. I have 2 Modules:

    FindTop2:

    Public Sub FindTop2()

    Dim strSQL As String

    strSQL = "INSERT INTO Assignments " & _

    "SELECT DISTINCT TOP 2 Requests.LASTNAME, Requests.FIRSTNAME, Requests.SENIORITY_DT, Requests.BIRTH_DT, Requests.REQDATE, Requests.REQTIME, Requests.Emp_No " & _

    "FROM Requests " & _

    "ORDER BY Requests.SENIORITY_DT, Requests.BIRTH_DT;"

    DoCmd.RunSQL strSQL

    End Sub

    ----------------------------------------------------------

    FindTop3

    Public Sub FindTop3()

    Dim strSQL As String

    strSQL = "SELECT DISTINCT TOP 3 Requests.LASTNAME, Requests.FIRSTNAME, Requests.SENIORITY_DT, Requests.BIRTH_DT, Requests.REQDATE, Requests.REQTIME, Requests.Emp_No " & _

    "INTO Assignments " & _

    "FROM Requests " & _

    "ORDER BY Requests.SENIORITY_DT, Requests.BIRTH_DT;"

    DoCmd.RunSQL strSQL

    End Sub

    +++++++++++++++++++++++++++++++++

    I need to invoke on a button's OnClik one or the other module based on:

    If (Day(Requests.ReqDate) >= 1 Or Day(Requests.ReqDate <= 5)) Then DoCmd.OpenModule (FindTop2) Else DoCmd.OpenModule (FindTop3)

    +++++++++++++++++++++++++++++++++

    I'm looking for this to run through the entire Requests table to pull the TOP 2 or TOP 3, depending on the DOW.

    The expected output I'm looking for is to populate a table named Assignments with the DISTINCT TOP 2 or DISTING TOP 3 records for each REQDATE and REQTIME.

    I'm thinking this will satisfy the selection of the TOP 2 or TOP 3 people for each day. I'm also thinking this will alleviate a need for a CHOICE field in the Requests table because it should just put the most senior 2 or 3 people for each specific start time by seniority based on inputted requests.

    Hope this helped.

  • nvrwrkn2 (3/11/2010)


    I need to invoke on a button's OnClik one or the other module based on:

    If (Day(Requests.ReqDate) >= 1 Or Day(Requests.ReqDate <= 5)) Then DoCmd.OpenModule (FindTop2) Else DoCmd.OpenModule (FindTop3)

    Hi nvrwrkn2,

    You should be able to call your procedures from the OnClick event of a button without too much pain.

    Instead of...

    [font="Courier New"]If (Day(Requests.ReqDate) >= 1 Or Day(Requests.ReqDate <= 5)) Then DoCmd.OpenModule (FindTop2) Else DoCmd.OpenModule (FindTop3)[/font]

    Just use...

    [font="Courier New"]If (Day(Requests.ReqDate) >= 1 Or Day(Requests.ReqDate <= 5)) Then Call FindTop2 Else Call FindTop3[/font]

    Cheers,

    RF

    _____________________________________________________________

    MAXIM 106:
    "To know things well, we must know the details; and as they are almost infinite, our knowledge is always superficial and imperfect."
    Francois De La Rochefoucauld (1613-1680)

  • ok that got me closer!

    It attempts to run but I get a Compile error:

    Expected variable or procedure, not module.

  • Aaaahhhh... it could be that your modules have the same names as your procedures, and they're conflicting. Try renaming the modules (not the procedures) and see if that works.

    _____________________________________________________________

    MAXIM 106:
    "To know things well, we must know the details; and as they are almost infinite, our knowledge is always superficial and imperfect."
    Francois De La Rochefoucauld (1613-1680)

  • arghhh.... so since I apparently can't call a module from inside an On-click sub I decided to insert the two routines into the same sub:

    Public Sub Run_Click()

    Dim strSQL As String

    strSQL = "SELECT Requests.REQDATE, Requests.REQTIME " & _

    "FROM Requests;"

    DoCmd.RunSQL strSQL

    If (Day(Requests.ReqDate) >= 1 Or Day(Requests.ReqDate <= 5)) Then Call FindTop2 Else Call FindTop3

    End Sub

    _____________________________________________________

    Public Function FindTop2()

    Dim strSQL As String

    strSQL = "INSERT INTO Assignments " & _

    "SELECT DISTINCT TOP 2 Requests.LASTNAME, Requests.FIRSTNAME, Requests.SENIORITY_DT, Requests.BIRTH_DT, Requests.REQDATE, Requests.REQTIME, Requests.Emp_No " & _

    "FROM Requests " & _

    "ORDER BY Requests.SENIORITY_DT, Requests.BIRTH_DT;"

    DoCmd.RunSQL strSQL

    End Function

    _______________________________________________________

    Public Function FindTop3()

    Dim strSQL As String

    strSQL = "INSERT INTO Assignments " & _

    "SELECT DISTINCT TOP 3 Requests.LASTNAME, Requests.FIRSTNAME, Requests.SENIORITY_DT, Requests.BIRTH_DT, Requests.REQDATE, Requests.REQTIME, Requests.Emp_No " & _

    "FROM Requests " & _

    "ORDER BY Requests.SENIORITY_DT, Requests.BIRTH_DT;"

    DoCmd.RunSQL strSQL

    End Function

    ******

    Now I'm getting the old RunSQL requires an argument.... at the end of Run_Click sub?

    I changed the names on the modules before I tried putting the code into the same procedure.

    I shouldn't need them anymore now anyways, correct?

  • EDIT:

    I should have read this first... πŸ™‚

    I'm looking for this to run through the entire Requests table to pull the TOP 2 or TOP 3, depending on the DOW.

    The expected output I'm looking for is to populate a table named Assignments with the DISTINCT TOP 2 or DISTING TOP 3 records for each REQDATE and REQTIME.

    I'm thinking this will satisfy the selection of the TOP 2 or TOP 3 people for each day. I'm also thinking this will alleviate a need for a CHOICE field in the Requests table because it should just put the most senior 2 or 3 people for each specific start time by seniority based on inputted requests.

    I'm off out in a few minutes, but I think I understand what you're after. I'll try and post something tomorrow!

    _____________________________________________________________

    MAXIM 106:
    "To know things well, we must know the details; and as they are almost infinite, our knowledge is always superficial and imperfect."
    Francois De La Rochefoucauld (1613-1680)

  • And I then tried this:

    Public Sub Run_Click()

    Dim strSQL As String

    strSQL = "SELECT Requests.REQDATE, Requests.REQTIME " & _

    "FROM Requests;"

    DoCmd.RunSQL strSQL

    Call DateTest

    End Sub

    -------------------------------------------------------------

    Public Sub DateTest()

    If (Day(Requests.ReqDate) >= 1 Or Day(Requests.ReqDate <= 5)) Then Call FindTop2 Else Call FindTop3

    End Sub

    ------------------------------------------------------------

    Public Function FindTop2()

    Dim strSQL As String

    strSQL = "INSERT INTO Assignments " & _

    "SELECT DISTINCT TOP 2 Requests.LASTNAME, Requests.FIRSTNAME, Requests.SENIORITY_DT, Requests.BIRTH_DT, Requests.REQDATE, Requests.REQTIME, Requests.Emp_No " & _

    "FROM Requests " & _

    "ORDER BY Requests.SENIORITY_DT, Requests.BIRTH_DT;"

    DoCmd.RunSQL strSQL

    End Function

    -------------------------------------------------------

    Public Function FindTop3()

    Dim strSQL As String

    strSQL = "INSERT INTO Assignments " & _

    "SELECT DISTINCT TOP 3 Requests.LASTNAME, Requests.FIRSTNAME, Requests.SENIORITY_DT, Requests.BIRTH_DT, Requests.REQDATE, Requests.REQTIME, Requests.Emp_No " & _

    "FROM Requests " & _

    "ORDER BY Requests.SENIORITY_DT, Requests.BIRTH_DT;"

    DoCmd.RunSQL strSQL

    End Function

    ---------------------------------------------

    If I run this from the cursor, I get a popup showing me the macros asking me to select them and run them. If I click the button I get the sql error.

  • and as I stare at that code I see it is nowhere near doing what I thought.

  • Hi nvrwrkn2,

    Sounds like you're having one of those days! πŸ˜€

    I'm trying to get my head into thinking in terms of "sets" as opposed to "cursors", but I'm not sure how you could easily do what you're after using just MS Access's cut-down version of SQL. What I do know is that you can easily do it using VBA by looping through a recordset, although it's most likely not as efficient as using just SQL.

    I feel dirty doing this as looping through each record in a recordset is wrong when I'm sure something could be done "all at once" with just pure SQL, but hey... it gets the job done! You can see the code below and you can copy it easily to a module (if you can't I'll attach it as a text file). At first glance, it might look like a lot of lines of code, but plenty of them are comments, and I've tried to lay it out so it's clear to understand and readable - especially the SQL.

    As we're adding data, before you do ANYTHING else, make sure you take a backup copy of your database and use a test copy until you're sure it works!!!

    Copy the code into a module and then set a reference to 'Microsoft ActiveX Data Objects 2 Library' - it shouldn't really matter which version number you choose but best to go for the latest version 2 in the list. To set a reference, make sure you're in a module and choose 'References' from the 'Tools' menu, and then scroll down the list and select the one you want.

    I haven't tested the code but it looks like it should be fine. Read through it so you have a reasonable idea what it's doing, and check the SQL statements to make sure they're not doing anything untoward. Once you're happy, then to run it, just press Ctrl-G to open up the Immediate Window and type Call PopulateTopAssignments

    Public Sub PopulateTopAssignments()

    '[SQL used to return the request dates we want to find the top records for]

    Const cstrDatesSQL As String = "SELECT Requests.REQDATE, " & _

    "Requests.REQTIME " & _

    "FROM Requests " & _

    "GROUP BY Requests.REQDATE, " & _

    "Requests.REQTIME"

    '[Core SQL to add the top 'n' records for a date to the assignments table]

    Const cstrAppendSQL = "INSERT INTO Assignments " & _

    "SELECT DISTINCT TOP {X} Requests.LASTNAME, " & _

    "Requests.FIRSTNAME, " & _

    "Requests.SENIORITY_DT, " & _

    "Requests.BIRTH_DT, " & _

    "Requests.REQDATE, " & _

    "Requests.REQTIME, " & _

    "Requests.Emp_No " & _

    "FROM Requests " & _

    "WHERE Requests.REQDATE = #{DATE}# AND " & _

    "Requests.REQTIME = #{TIME}# " & _

    "ORDER BY Requests.SENIORITY_DT, " & _

    "Requests.BIRTH_DT;"

    '[Recordset holding the request dates we want to find the top records for]

    Dim rst As ADODB.Recordset

    '[SQL used to add the top 'n' records for a date to the assignments table]

    Dim strAppendSQL As String

    '[Instantiate a new recordset]

    Set rst = New ADODB.Recordset

    With rst

    '[Populate the recordset with the request dates we want to work with]

    .Open cstrDatesSQL, CurrentProject.Connection, adOpenKeyset

    '[Make sure we've got records to deal with]

    If Not .BOF And Not .EOF Then

    '[Go to the first record]

    .MoveFirst

    '[Loop through the records until we reach the last one]

    Do Until .EOF

    '[Make sure we've got a date to work with]

    If Not IsNull(.Fields("REQDATE")) Then

    '[Determine what day number of the week the request date is]

    Select Case Weekday(.Fields("REQDATE"))

    '[Friday or Saturday]

    Case 5, 6

    '[Build SQL to add top 2 records for the date to

    ' the assignments table]

    strAppendSQL = Replace(cstrAppendSQL, "{X}", 2)

    strAppendSQL = Replace(strAppendSQL, "{DATE}", _

    .Fields("REQDATE"))

    strAppendSQL = Replace(strAppendSQL, "{TIME}", _

    .Fields("REQTIME"))

    '[Monday - Friday]

    Case Else

    '[Build SQL to add the top 3 records for the date to

    ' the assignments table]

    strAppendSQL = Replace(cstrAppendSQL, "{X}", 3)

    strAppendSQL = Replace(strAppendSQL, "{DATE}", _

    .Fields("REQDATE"))

    strAppendSQL = Replace(strAppendSQL, "{TIME}", _

    .Fields("REQTIME"))

    End Select

    '[Add the relevant top records for the date to the assignments

    ' table]

    CurrentDb.Execute strAppendSQL

    End If

    '[Go get the next record to deal with]

    .MoveNext

    Loop

    End If

    '[Close the recordset now we've finished with it]

    .Close

    End With

    '[Release object variable pointer from memory]

    Set rst = Nothing

    End Sub

    Cheers and good luck!

    RF

    _____________________________________________________________

    MAXIM 106:
    "To know things well, we must know the details; and as they are almost infinite, our knowledge is always superficial and imperfect."
    Francois De La Rochefoucauld (1613-1680)

  • wow...

    I can't begin to tell you how much I appreciate the time you must have spent figuring this all out.

    If this is what it takes to accomplish the task I can unequivocally state I never would have been able to learn that much in the short amount of time I've been given to do this.

    Thank you once again.

    On to the results though:

    I got an unknown run-time error of -2147217900 (80040e14)

    the debug stopped it here:

    .Open cstrDatesSQL, CurrentProject.Connection, adOpenKeyset

    I referenced Microsoft ActiveX Data Objects 2.5 library

    Does this look like an error due to the library I used?

  • just as an aside, I attempted to do this through pure SQL with this:

    Public Sub Doit()

    Dim strSQL As String

    strSQL = "SELECT requests.lastname, requests.firstname, requests.star, requests.seniority_dt, requests.reqdate, requests.reqtime " & _

    "INTO Assignments " & _

    "FROM requests " & _

    "WHERE (not exists (requests.emp_no)) and requests.emp_no IN " & _

    "(SELECT TOP 2 requests.seniority_dt, requests.birth_dt, requests.emp_no, requests.reqdate, requests.reqtime " & _

    "FROM requests " & _

    "ORDER BY requests.seniority_dt, requests.birth_dt " & _

    "WHERE (((Requests.reqdate) In ("SELECT requests.reqdate, requests.reqtime " & _

    "FROM requests;")) AND ((Requests.reqtime) In ("SELECT requests.reqdate, requests.reqtime " & _

    "FROM requests;"))) " & _

    "(SELECT requests.reqdate, requests.reqtime " & _

    "FROM requests;"

    DoCmd.RunSQL strSQL

    End Sub

    *******************************

    Needless to say that won't compile πŸ˜€

    And as I look at it it won't take into account the person next down the list in seniority and insert the record, it would just not add an employee if his employee # was already in the new table. So if I can get the above working at all, I would then need a way to keep checking a previous failed insert and choose the next person down in seniority and insert them into the table on the same date/time that the failed insert occurred.

    Why does this sound so simple yet the code required is so difficult to get, at least for me anyway.

    Since I can't understand most of your hard work above I can't follow it's logic.

  • think I might be onto the problem..... in researching the error with currentproject.connection I'm seeing that it "might" have something to do with the connection to the database. I found something to the effect that the stock currentproject.connection is normally used for connecting to an MDB file. I know I failed to mention that I'm using Access 2007 which uses an accdb file, and I'm not using a back end setup either, it's all in the accdb file for the moment.

    The person with the similar problem posted his own connection string as:

    Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\MyData\MyData.accdb

    The response was:

    That's for MDBs: for ACCDBs, you need to use

    Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\MyData\MyData.accdb;Persist

    Security Info=False;

    Does this help or is does this have nothing to do with the problem?

Viewing 15 posts - 1 through 15 (of 36 total)

You must be logged in to reply to this topic. Login to reply