Access, VBA: Find First not working correctly - vba

I hope this is a simple question for someone. I have this method that uses two form fields to check if a record exists in my table and either adds a record or does nothing. So if patient_id is 100, and visit_number is 1, then I will only add a new record if it doesn't already exist.
So, if rst.NoMatch is true - add a new record. However, I can't get it to recognize a duplicate. Here is the code:
Private Sub add_record_button_Click()
Dim rst As DAO.Recordset
Set rst = Me.RecordsetClone
Dim dbs As DAO.Database
Set dbs = CurrentDb
If IsNull(Form.patient_id) Or IsNull(Form.visit_number) = True Then
MsgBox "Please fill in both fields."
Else
rst.FindFirst "[patient_id] = " & Form.patient_id & " And [visit_number] = " & Form.visit_number
If rst.NoMatch Then
Set rst = dbs.OpenRecordset("Visits")
rst.AddNew
rst!patient_id = Form.patient_id
rst!visit_number = Form.visit_number
rst.Update
MsgBox "New patient visit has been added to the database."
Else
MsgBox "That visit already exists."
End If
rst.Close
End If
End Sub
I believe that my FindFirst line isn't correct. In the database, the variables are named patient_id and visit_number. On the form they are named the same.
Any help would be appreciated, thanks.
EDIT.
From the comments below, I was able to get my logic working but using a different compare feature, Dlookup.
IsNull(DLookup("[patient_id]", "MyTable", "[patient_id] = " & Forms("MyForm").patient_id & " AND [visit_number] = " & Forms("MyForm").visit_number)
FINAL EDIT.
The above line made everything work if I used the form directly, however if I put the form into a navigation form - it stopped working. The string that ultimately got it working from within a navigation form looks like this:
If IsNull(DLookup("[patient_id]", "Visits", "[patient_id] = " & Me!patient_id.Value & " AND [visit_number] = " & Me!visit_number.Value)) = True Then
Thank you all for your help.

I've never seen Form used this way, and you should be able to add the record directly in the form, so try:
Private Sub add_record_button_Click()
Dim rst As DAO.Recordset
Set rst = Me.RecordsetClone
Dim PatientId As Variant
Dim VisitNumber As Variant
PatientId = Me!patient_id.Value
VisitNumber = Me!visit_number.Value
If IsNull(PatientId) Or IsNull(VisitNumber) Then
MsgBox "Please fill in both fields."
Else
rst.FindFirst "[patient_id] = " & PatientId & " And [visit_number] = " & VisitNumber & ""
If rst.NoMatch Then
rst.AddNew
rst!patient_id.Value = PatientId
rst!visit_number.Value = VisitNumber
rst.Update
MsgBox "New patient visit has been added to the database."
Else
MsgBox "That visit already exists."
Me.Bookmark = rst.Bookmark
End If
End If
End Sub

Related

Access VBA After Insert Autofill?

I'm looking for a little help/input on how to have a field auto-populate after an identification number is entered in a new record.
I have an entry screen ("RetailEntry") where someone will enter a "Pack Number" once they either move to another record I'd like the "Description" field to populate with the corresponding "Description" ("qryDescriptions") for that pack number.
Example:
If I enter pack number 6781234 it would give me the Description "Test"
I'm trying to figure out the best way of doing this and I thought maybe a record loop like below where it runs a query for the pack number and description then loops through the records to fill it in. It kinda works if I only enter one pack number but adding anymore pack numbers or copy and pasting multiple pack numbers it errors with a "No Current Record" which I'm guessing has to do with the order of processes. I am really hoping there is a way to do this where it will autofill vs me having to add a button to make this work.
Any thoughts, advice or help is greatly appreciated!!
Code:
Private Sub Form_AfterInsert()
Dim db As Dao.Database
Dim Desc As String
Dim PDesc As String
Dim rs As Dao.Recordset
Dim rq As Dao.Recordset
'Set Description
Set db = CurrentDb
Set rs = CurrentDb.OpenRecordset("RetailEntry")
Set rq = CurrentDb.OpenRecordset("qryDescriptions")
PDesc = rs.Fields("Pack_Number").Value
Desc = "SELECT DISTINCT PackNum, Description " _
& " FROM PIC704Current " _
& " WHERE Packnum = '" & PDesc & "'"
strSQL = Desc
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
db.QueryDefs.Delete "qryDescriptions"
Set qdfPassThrough = db.CreateQueryDef("qryDescriptions")
qdfPassThrough.Connect = "ODBC;DSN=SupplyChainMisc;Description=SupplyChainMisc;Trusted_Connection=Yes;DATABASE=SupplyChain_Misc;"
qdfPassThrough.ReturnsRecords = True
qdfPassThrough.ODBCTimeout = 180
qdfPassThrough.SQL = strSQL
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Loop version
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If Not (rs.EOF And rs.BOF) Then
rs.MoveFirst
rq.MoveFirst
Do Until rs.EOF = True
If rs.Fields("Description").Value <> rq.Fields("Description").Value Then
Else
Me!Description.Value = rq.Fields("Description").Value
End If
rs.MoveNext
rq.MoveNext
Loop
End If
End Sub

MSAccess Form Search-Button conflicts with Edit-Button

I'm new to this forum and quite new to Access. I have the following problem. I've created an Form/Subform to edit the Data of a Query. Two Controls seem to be in conflict in my code.
"Search_Order" is an unbound text field. If text is entered and enter is pressed the corresponding fields of a query are shown. The code looks like the following:
Set rs_Search = Me.RecordsetClone
rs_Search.FindFirst "[OrderNumber]=""" & Search_Order & """"
If rs_Search.NoMatch Then
MsgBox "Sorry, no such record '" & Search_Order & "' was found.", _
vbOKOnly + vbInformation
Else
Me.Recordset.Bookmark = rs_Search.Bookmark
End If
rs_Search.Close
Search_Order = Null
Set rs_Search = Nothing
End Sub
The second command "ButtonSetOrderDetails10" should create a RecordsetClone of the Subform "sfrmChangeOrderDetails" and change the Value of the Field "OrderStatus" to the Vlaue of "10".
It has this code:
Private Sub ButtonSetOrderDetails10_Click()
Dim rs_Status_Change As DAO.Recordset
Set rs_Status_Change = Me.sfrmChangeOrderDetails.Form.RecordsetClone
With rs_Status_Change
Do While Not .EOF
.Edit
.Fields("OrderStatus") = 10
.Update
.MoveNext
Loop
End With
rs_Status_Change.Close
Set rs_Status_Change = Nothing
End Sub
I've looked both codes here up and modified them to the needs of my database. Both codes work fine so far, but unfortunately only once.
My problem is that as soon as I hit the Button "ButtonSetOrderDetails10" I can't do the same trick with a different order. I can search for the other order, it is displayed but the Button "ButtonSetOrderDetails10" does not work anymore. If I close the Form and reopen it, it works again.
It would be great if someone can give me a hint what I'm doing wrong here.
Best regards, Ferdi
I am surprised even works one time. With DAO recordset need to read dataset into memory before it will be able see records for edit otherwise just sees EOF and the loop doesn't run. Try:
rs_Status_Change.MoveLast
rs_Status_Change.MoveFirst
With rs_Status_Change
Don't even need to declare/set/close a recordset object.
Private Sub Search_Order_AfterUpdate()
With Me.RecordsetClone
.FindFirst "[OrderNumber]='" & Me.Search_Order & "'"
If .NoMatch Then
MsgBox "Sorry, no such record '" & Me.Search_Order & "' was found.", _
vbOKOnly + vbInformation
Else
Me.Bookmark = .Bookmark
End If
End With
Me.Search_Order = Null
End Sub
Private Sub ButtonSetOrderDetails10_Click()
With Me.sfrmChangeOrderDetails.Form.RecordsetClone
.MoveLast
.MoveFirst
Do While Not .EOF
.Edit
.Fields("OrderStatus") = 10
.Update
.MoveNext
Loop
End With
End Sub
Could really simplify code by running an UPDATE action SQL.
Private Sub ButtonSetOrderDetails10_Click()
CurrentDb.Execute "UPDATE ChangeOrderDetails SET OrderStatus=10 WHERE OrderNumber='" & Me.OrderNumber & "'"
End Sub

ADO Recordset data not showing on form

I've got a frustrating issue on MS Access 2010 that I would at this stage qualify as a bug. And after having tried all possible workarounds, I am out of ideas and rely on you.
Context
Huge Ms Access 2010 application with 25k lines of VBA and >50 forms. It has a client server architecture with a frontend compiled and an Access backend on the network. It makes connections to a twentish of different databases (Oracle/SQL Server/Sybase IQ).
The problem
Sometimes when I assign an ADODB recordset to a subform, its data isn't shown in bound fields. I've got #Name? everywhere
The data is there. I can debug.print it, I can see it in the Watches browser, I can read or manipulate it while looping on the recordset object with code. It just not appear in the subform.
It can work flawlessly during months, and suddenly one form will start having this issue without any apparent reason (it might happen even on forms that I have not changed). When it happens, it does for all users, so this is really something wrong in the frontend accdb/accde.
The issue is not related to a specific DBMS/Driver. It can happen with Oracle or Sybase data.
I have created my own class abstracting everything related to ADO connections and queries, and use the same technique everywhere. I've got several tenth of forms based on it and most of them works perfectly.
I have this issue in several parts of my application, and especially in a highly complicated form with lots of subforms and code.
On this Main form, a few subforms have the issue, while others don't. And they have the exact same parameters.
The Code
This is how I populate a form's recordset :
Set RST = Nothing
Set RST = New ADODB.Recordset
Set RST = Oracle_CON.QueryRS(SQL)
If Not RST Is Nothing Then
Set RST.ActiveConnection = Nothing
Set Form_the_form_name.Recordset = RST
End If
The code called with Oracle_CON.QueryRS(SQL) is
Public Function QueryRS(ByVal SQL As String, Optional strTitle As String) As ADODB.Recordset
Dim dbQuery As ADODB.Command
Dim Output As ADODB.Recordset
Dim dtTemp As Date
Dim strErrNumber As Long
Dim strErrDesc As String
Dim intSeconds As Long
Dim Param As Variant
If DBcon.state <> adStateOpen Then
Set QueryRS = Nothing
Else
DoCmd.Hourglass True
pLastRows = 0
pLastSQL = SQL
pLastError = ""
pLastSeconds = 0
Set dbQuery = New ADODB.Command
dbQuery.ActiveConnection = DBcon
dbQuery.CommandText = SQL
dbQuery.CommandTimeout = pTimeOut
Set Output = New ADODB.Recordset
LogIt SQL, strTitle
dtTemp = Now
On Error GoTo Query_Error
With Output
.LockType = adLockPessimistic
.CursorType = adUseClient
.CursorLocation = adUseClient
.Open dbQuery
End With
intSeconds = DateDiff("s", dtTemp, Now)
If Output.EOF Then
LogIt "-- " & Format(Now, "hh:nn:ss") & " | Executed in " & intSeconds & " second" & IIf(intSeconds = 1, "", "s") & " | Now rows returned."
Set QueryRS = Nothing
Else
Output.MoveLast
pLastRows = Output.RecordCount
LogIt "-- " & Format(Now, "hh:nn:ss") & " | Executed in " & intSeconds & " second" & IIf(intSeconds = 1, "", "s") & " | " & Output.RecordCount & " row" & IIf(Output.RecordCount = 1, "", "s") & " returned."
Output.MoveFirst
Set QueryRS = Output
End If
End If
Exit_Sub:
pLastSeconds = intSeconds
Set Output = Nothing
Set Parameter = Nothing
Set dbQuery = Nothing
DoCmd.Hourglass False
Exit Function
Query_Error:
intSeconds = DateDiff("s", dtTemp, Now)
strErrNumber = Err.Number
strErrDesc = Err.DESCRIPTION
pLastError = strErrDesc
MsgBox strErrDesc, vbCritical, "Error " & pDSN
LogIt strErrDesc, , "ERROR"
Set QueryRS = Nothing
Resume Exit_Sub
Resume
End Function
Things I tried so far
For the recordsets I tried every possible variation of
.LockType = adLockPessimistic
.CursorType = adUseClient
.CursorLocation = adUseClient
The subforms handling the recordsets have all a Snapshot recordsettype, problem remains if I try dynaset.
Dataentry, Addition, deletion, edits are all disabled. It's pure read-only.
I have a habit of disconnecting the recordsets using RST.ActiveConnection = Nothing so I can manipulate them afterwards, but this doesn't impact the problem either.
It can happens with very simple queries with only one field in the SELECT clause and only one field bound to it on a subform.
Reimporting all objects in a fresh accdb doesn't solve the problem either.
The solution proposed by random_answer_guy worked at first glance, which accreditate the bug hypothesis. Unfortunately my problems reappeared after some (totaly unrelated) changes in the main form. I am back with 4 or 5 subforms not showing data and adding/removing a Load event on all or part of them doesn't make any difference anymore
If you want more information about how weird is this issue, I advise you to read my comment on random_answer_guy's answer.
To conclude
What is extremely frustrating is that I can have 2 different forms with exactly the same properties and same fields, same SQL instruction over the same DB, same recordset management code: One is showing the data and the other doesn't !
When the problem happens, I have no other choice than erasing all objects manipulated and reimporting them from an older version or recreate them from scratch.
If this is not a bug, I am still looking for the proper word to qualify it.
Does anyone ever experienced the issue and has an explanation and/or a workaround to propose ?
I've had this same issue before and simply adding a blank Form_Load event solved the problem. No code needs to be with the Form_Load it just needs to be present.
So nobody could give at this stage a clear answer to the main question :
Why is this bug happens ?
In the meantime I have "elegantly" bypassed the issue by changing the method used for the subforms encountering the bug, from ADO to DAO.
I have created a new method in my ADO abstracting class, that actually use DAO to return a recordset (not logical, but hey...).
The code where I pass data to the form becomes :
Set RST = Nothing
Set RST = Oracle_CON.QueryDAORS(SQL)
If Not RST Is Nothing Then
Set Form_the_form_name.Recordset = RST
End If
And here's the method QueryDAORS called :
Public Function QueryDAORS(ByVal SQL As String, Optional strTitle As String) As DAO.Recordset
Dim RS As DAO.Recordset
Dim dtTemp As Date
Dim strErrNumber As Long
Dim strErrDesc As String
Dim intSeconds As Long
Dim Param As Variant
On Error GoTo Query_Error
dtTemp = Now
If DBcon.state <> adStateOpen Then
Set QueryDAORS = Nothing
Else
DoCmd.Hourglass True
Set pQDEF = CurrentDb.CreateQueryDef("")
pQDEF.Connect = pPassThroughString
pQDEF.ODBCTimeout = pTimeOut
pQDEF.SQL = SQL
pLastRows = 0
pLastSQL = SQL
pLastError = ""
pLastSeconds = 0
LogIt SQL, strTitle, , True
Set RS = pQDEF.OpenRecordset(dbOpenSnapshot)
intSeconds = DateDiff("s", dtTemp, Now)
If RS.EOF Then
LogIt "-- " & Format(Now, "hh:nn:ss") & " | Executed in " & intSeconds & " second" & IIf(intSeconds = 1, "", "s") & " | Now rows returned."
Set QueryDAORS = Nothing
Else
RS.MoveLast
pLastRows = RS.RecordCount
LogIt "-- " & Format(Now, "hh:nn:ss") & " | Executed in " & intSeconds & " second" & IIf(intSeconds = 1, "", "s") & " | " & RS.RecordCount & " row" & IIf(RS.RecordCount = 1, "", "s") & " returned."
RS.MoveFirst
Set QueryDAORS = RS
End If
End If
Exit_Sub:
pLastSeconds = intSeconds
Set RS = Nothing
DoCmd.Hourglass False
Exit Function
Query_Error:
intSeconds = DateDiff("s", dtTemp, Now)
strErrNumber = Err.Number
strErrDesc = Err.DESCRIPTION
pLastError = strErrDesc
MsgBox strErrDesc, vbCritical, "Error " & pDSN
LogIt strErrDesc, , "ERROR"
Set QueryDAORS = Nothing
Resume Exit_Sub
Resume
End Function
The property pPassThroughString is defined with another Method using the properties that I already had at my disposal in the class, because they were neccessary to open an ADO connection to the database :
Private Function pPassThroughString() As String
Select Case pRDBMS
Case "Oracle"
pPassThroughString = "ODBC;DSN=" & pDSN & ";UID=" & pUsername & ";Pwd=" & XorC(pXPassword, CYPHER_KEY)
Case "MS SQL"
pPassThroughString = "ODBC;DSN=" & pDSN & ";DATABASE=" & pDBname & ";Trusted_Connection=Yes"
Case "Sybase"
pPassThroughString = "ODBC;DSN=" & pDSN & ";"
Case Else
MsgBox "RDBMS empty ! ", vbExclamation
LogIt "RDBMS empty ! ", , "ERROR"
End Select
End Function
So the issue was solved rapidly by just changing the recordset assigned to the forms from ADODB.Recordset to DAO.recordset and adapting the method called from .OpenRS to .OpenDAORS.
The only con is that with DAO I can't use this anymore to disconnect the recordset:
Set RST.ActiveConnection = Nothing
Still, I would have prefered to get an explanation and fix :(

Table for priorities?

I am curious to know if there is a way to make a table based off priorities?
As in you have a form, subform (datasheet), and 2 buttons.
The subform takes data from a query which takes data from a table.
From here, the query shows projects. You can select the project on the subform and click a button to dec priority, which moves it DOWN on the list by 1 project. If you click the inc button, it moves it UP. If it's at the very bottom and you click the decrease button it will pop up saying "This project is already the lowest priority!" same with the increase, but it'll say it's already the highest.
Is this possible? I really don't know any VBA to access a subform's datasheet and modify it, and I'd like to learn.
UPDATE:
I have 1 table, with 5 priority types, and 1 key.
The table is named ProjectsT, the key is named ProjectID and the 5 priorities are:
CuttingPriority, ProjPriority, EngineerPriority, CutplanPriority, HardwarePriority. Each priority is listed as a number datatype.
This is one set of code I have so far for the buttons from an answer below:
Up button:
Dim strSQL As String
Dim intSavePos As Integer
Dim intSavePosMin As Integer
Dim intSavePosMax As Integer
'Save start and end value (It's assumed you start with 1 ! The value 0 (zero) is used for swapping value's)
intSavePosMin = DMin("CuttingPriority", "ProjectsT")
intSavePosMax = DMax("CuttingPriority", "ProjectsT")
'When the subform is linked to a keyfield use that field for a WHERE like:
'intSavePosMin = DMin("sequence", "tblTableNico5038", "Function='" & Me.sfrmFunctionTables.Form.Function & "'")
'intSavePosMax = DMax("sequence", "tblTableNico5038", "Function='" & Me.sfrmFunctionTables.Form.Function & "'")
intSavePos = Me.txtCuttingPriority
'is it the first ? ==> no action
If intSavePos = intSavePosMin Then Exit Sub
'switch positions
DoCmd.SetWarnings False
strSQL = "UPDATE ProjectsT SET ProjectsT.CuttingPriority = 0 WHERE CuttingPriority=" & intSavePos & ";"
'When the subform is linked to a keyfield use that field for a WHERE like:
'strSQL = "UPDATE tblTableNico5038 SET tblTableNico5038.Sequence = 0 WHERE Function='" & Me.sfrmTableNico5038.Form.Function & "' AND sequence=" & intSavePos & ";"
DoCmd.RunSQL strSQL
strSQL = "UPDATE ProjectsT SET ProjectsT.CuttingPriority = " & intSavePos & " WHERE CuttingPriority=" & intSavePos - 1 & ";"
'When the subform is linked to a keyfield use that field for a WHERE like:
'strSQL = "UPDATE tblTableNico5038 SET tblTableNico5038.Sequence = " & intSavePos & " WHERE Function='" & Me.sfrmTableNico5038.Form.Function & "' AND sequence=" & intSavePos - 1 & ";"
DoCmd.RunSQL strSQL
strSQL = "UPDATE ProjectsT SET ProjectsT.CuttingPriority = " & intSavePos - 1 & " WHERE CuttingPriority=0;"
'When the subform is linked to a keyfield use that field for a WHERE like:
'strSQL = "UPDATE tblTableNico5038 SET tblTableNico5038.Sequence = " & intSavePos - 1 & " WHERE Function='" & Me.sfrmTableNico5038.Form.Function & "' AND sequence=0;"
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
Me.Refresh
Me.ProjectsTCuttingSubF.SetFocus
SendKeys ("{up}")
Down button:
Dim strSQL As String
Dim intSavePos As Integer
Dim intSavePosMin As Integer
Dim intSavePosMax As Integer
intSavePosMin = DMin("CuttingPriority", "ProjectsT")
intSavePosMax = DMax("CuttingPriority", "ProjectsT")
intSavePos = Me.txtCuttingPriority
'is it the last ? ==> no action
If intSavePos = intSavePosMax Then Exit Sub
'switch positions
DoCmd.SetWarnings False
strSQL = "UPDATE ProjectsT SET ProjectsT.CuttingPriority = 0 WHERE CuttingPriority=" & intSavePos & ";"
DoCmd.RunSQL strSQL
strSQL = "UPDATE ProjectsT SET ProjectsT.CuttingPriority = " & intSavePos & " WHERE CuttingPriority=" & intSavePos + 1 & ";"
DoCmd.RunSQL strSQL
strSQL = "UPDATE ProjectsT SET ProjectsT.CuttingPriority = " & intSavePos + 1 & " WHERE CuttingPriority=0;"
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
Me.Refresh
Me.ProjectsTCuttingSubF.SetFocus
SendKeys ("{down}")
--
I was curious to see if I could come up with a solution that didn't resort to "SQL glue-up". The result is available for download here (Access 2010 or later).
The key components are a [Managers] table
ID ManagerName
-- --------------
1 Thompson, Gord
2 Elk, Anne
a [Projects] table
ID ManagerID Description Priority
-- --------- -------------------- --------
1 1 buy bacon 1
2 1 wash the car 2
3 1 clean out the garage 3
4 2 test1 1
5 2 test2 2
two saved parameter queries (QueryDefs) to locate the next highest/lowest-priority project
[GetHigherPriorityProject]
PARAMETERS prmManagerID Long, prmCurrentPriority Long;
SELECT TOP 1 Projects.ID, Projects.Priority
FROM Projects
WHERE (((Projects.Priority)<[prmCurrentPriority])
AND ((Projects.ManagerID)=[prmManagerID]))
ORDER BY Projects.Priority DESC , Projects.ID;
[GetLowerPriorityProject]
PARAMETERS prmManagerID Long, prmCurrentPriority Long;
SELECT TOP 1 Projects.ID, Projects.Priority
FROM Projects
WHERE (((Projects.Priority)>[prmCurrentPriority])
AND ((Projects.ManagerID)=[prmManagerID]))
ORDER BY Projects.Priority, Projects.ID;
one more saved parameter query to update the priority of a given project
[SetProjectPriority]
PARAMETERS prmNewPriority Long, prmID Long;
UPDATE Projects SET Projects.Priority = [prmNewPriority]
WHERE (((Projects.ID)=[prmID]));
a dead-simple Class just to hold a couple of Properties
[projectInfo]
Option Compare Database
Option Explicit
Private pID As Long, pPriority As Long
Public Property Get ID() As Long
ID = pID
End Property
Public Property Let ID(Value As Long)
pID = Value
End Property
Public Property Get Priority() As Long
Priority = pPriority
End Property
Public Property Let Priority(Value As Long)
pPriority = Value
End Property
a rudimentary form with a subform
and the code behind that form
Option Compare Database
Option Explicit
Private Sub cmdMoveDown_Click()
AdjustPriority "lower"
End Sub
Private Sub cmdMoveUp_Click()
AdjustPriority "higher"
End Sub
Private Sub AdjustPriority(Direction As String)
Dim cdb As DAO.Database, rst As DAO.Recordset, qdf As DAO.QueryDef
Dim currentProjectID As Long, otherProject As projectInfo
Set rst = Me.ProjectsSubform.Form.RecordsetClone
rst.Bookmark = Me.ProjectsSubform.Form.Recordset.Bookmark
currentProjectID = rst!ID
Set otherProject = GetOtherProject(rst!ManagerID, rst!Priority, Direction)
If otherProject.ID = 0 Then
MsgBox "There is no project with a " & Direction & " priority."
Else
Set cdb = CurrentDb
Set qdf = cdb.QueryDefs("SetProjectPriority")
' swap priorities
qdf!prmNewPriority = rst!Priority
qdf!prmID = otherProject.ID
qdf.Execute
qdf!prmNewPriority = otherProject.Priority
qdf!prmID = currentProjectID
qdf.Execute
Set qdf = Nothing
Set cdb = Nothing
Me.ProjectsSubform.Requery
' now restore the previous current record in the subform
Set rst = Me.ProjectsSubform.Form.RecordsetClone
rst.FindFirst "ID=" & currentProjectID
Me.ProjectsSubform.Form.Recordset.Bookmark = rst.Bookmark
End If
rst.Close
Set rst = Nothing
Set otherProject = Nothing
End Sub
Private Function GetOtherProject(prmManagerID As Long, _
prmCurrentPriority As Long, _
Direction As String) As projectInfo
Dim cdb As DAO.Database, qdf As DAO.QueryDef, rst As DAO.Recordset
Dim rtn As New projectInfo
Set cdb = CurrentDb
If Direction = "higher" Then
Set qdf = cdb.QueryDefs("GetHigherPriorityProject")
Else
Set qdf = cdb.QueryDefs("GetLowerPriorityProject")
End If
qdf!prmManagerID = prmManagerID
qdf!prmCurrentPriority = prmCurrentPriority
Set rst = qdf.OpenRecordset(dbOpenSnapshot)
If rst.EOF Then
rtn.ID = 0
rtn.Priority = 0
Else
rtn.ID = rst!ID
rtn.Priority = rst!Priority
End If
rst.Close
Set rst = Nothing
Set qdf = Nothing
Set cdb = Nothing
Set GetOtherProject = rtn
Set rtn = Nothing
End Function
EDIT re: comment
is there a way to make it automatically add the next priority number on the list if you are adding a record through another form?
Yes. I forgot to mention that in the existing sample solution there is a Before Change Data Macro on the [Projects] table to do just that:
If [IsInsert] Then
If Not IsNull([ManagerID]) Then
SetField
Name Priority
Value = Nz(DMax("Priority", "Projects", "ManagerID=" & [ManagerID]), 0) + 1
End If
End If
Read through the ENTIRE conversation here:
re-order a records sequence using up and down buttons
You're going to need at aleast a mediocre understanding of VBA and how to apply your specific data to a pre-existing example. This person was looking to do almost precisely what your question describes, and the person who was working with him was an Access MVP. I say to read through the entire conversation because there were several iterations and tweaks performed over the course of the solution.
If you have any specific questions after integrating this solution, feel free to come back and ask.
I have a work ticket system in my work place and to create priorities I created two tables: Work_Tickets and Work_Ticket_Criteria. The criteria table has a list of low, low-medium, etc... and a field in Work_Tickets pulls from that 2nd table. Then sort by date.
It doesn't give a single ticket a numerical priority like you are looking for because to do that I believe you would have to create a separate field and then modify the numerical field of each record after every update. Switch 1 with 2, or make the new record 1 and then add 1 to each and every record's priority field to move them down the list.
Or if you start with a number like 1000 then you can make records more or less than 100 in increments of 5, 10, or 20 but then you'll eventually run out of numbers...
Update
If you're willing to go my method of adding another column, then I would just add column and name the field Priority_Numbers or something. Then you would mark each as 1 - whatever but you may want to make check to make sure your number doesn't already exist by making it a key or giving it a check.
Then each time you would want to view your tickets you would use something like:
Dim strSQL As String
Dim myR As Recordset
strSQL = "SELECT * FROM table_name WHERE criteria_here ORDER BY Priority_Numbers ASC"
Set myR = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
And bam you have your prioritized list.
Now to change the priority you would need to select that recordset, do a findfirst to get the record with the value you want replaced, +1 or -1 to each priority number in a While not EOF loop and keep moving next. This will become tedious if your tickets become too high I'm sure.

If Then Else on 2 separate recordsets

I need to test 2 different conditions on 2 separate recordsets. I am not good with VBA, I have a very basic code, I just need help with If Then syntax. Here is my Code:
Private Sub SaveRecord_Click()
'**** add a new record ****
Dim db As Database, rs1 As Recordset, rs2 As Recordset
Set db = CurrentDb
Set rs1 = db.OpenRecordset("ExpAsset", DB_OPEN_DYNASET)
Set rs2 = db.OpenRecordset("LogTest", DB_OPEN_DYNASET)
'**** Following code is updating the tables in the ExpAsset table with new information from the form****
If rs1.NoMatch Then
rs1.AddNew
rs1("User") = Me!Location
rs1("Type") = Me!Type
rs1("Model") = Me!MODEL
rs1("Asset_ID") = Me!Asset_ID
rs1("Serial_Number") = Me!Serial
rs1.Update
Else
MsgBox "Serial Number: " & Me!Serial & " already exists.", 48, "ERROR!"
Me!Serial.SetFocus
End If
'**** Following code is creating a log in Logtest table with information provided in the form****
If rs2.NoMatch Then
rs2.AddNew
rs2("Asset_Type") = Me!Type
rs2("Transfer_Type") = "New purchase"
rs2("Description") = Me!DESCRIPTION
rs2("DELIVERED_TO") = Me!Location
rs2("DELIVERED_BY") = Me!DeliveredBy
rs2("RECEIVED_BY") = Me!Receiver
rs2("RECEIVED_DATE") = Me!Date
rs2.Update
MsgBox "Part information has been updated in the database!"
'clear the controls to add more customers
Call ClearControls
Else
MsgBox "Asset ID: " & Me!Asset_ID & " already exists.", 48, "ERROR!"
Me!Asset_ID.SetFocus
End If
rs1.Close
rs2.Close
db.Close
End Sub
I know The If Then Else syntax is incorrect, I need to check both conditions, serial no. and asset ID.
Check the Access online help topic for Recordset.NoMatch Property:
Indicates whether a particular record was found by using the Seek method or one of the Find methods (Microsoft Access workspaces only).
However in your code, you're opening a recordset but not using either seek or find. In that situation, you haven't asked to match anything, so .NoMatch will be False every time. The logic is similar to this ...
If rs1.NoMatch Then
' this code will never run
Else
' this code runs every time
End If
You can use DCount to determine whether ExpAsset contains a given Asset_ID value.
DCount("*", "ExpAsset", "Asset_ID = " & Me!Asset_ID) ' if Asset_ID is numeric
DCount("*", "ExpAsset", "Asset_ID = '" & Me!Asset_ID & "'") ' if Asset_ID is text
Once you have a working DCount expression, you can use logic like this ...
If DCount("*", "ExpAsset", "Asset_ID = " & Me!Asset_ID) = 0 Then
' Asset_ID not present in table -> add it
Else
' inform user Asset_ID already present in table
End If
You are right HansUp, my code was silly, I realised later after I had posted that there was no criteria to test against. Following is the right code, I tested it and it works :)
Private Sub SaveRecord_Click()
'**** add a new record ****
Dim db As Database, rs1 As Recordset, rs2 As Recordset, Criteria As String, Criteria2 As String
Set db = CurrentDb
Set rs1 = db.OpenRecordset("ExpAsset", DB_OPEN_DYNASET)
Set rs2 = db.OpenRecordset("LogTest", DB_OPEN_DYNASET)
Criteria = "[serial_number]='" & Me!Serial & "'"
Criteria2 = "[Asset_ID]='" & Me!Asset_ID & "'"
'**** Following code is updating the tables in the ExpAsset table with new information from the form****
rs1.FindFirst Criteria
If rs1.NoMatch Then
rs1.FindFirst Criteria2
If rs1.NoMatch Then
rs1.AddNew
rs1("User") = Me!Location
rs1("Type") = Me!Type
rs1("Model") = Me!MODEL
rs1("Asset_ID") = Me!Asset_ID
rs1("Serial_Number") = Me!Serial
rs1.Update
'**** Following code is creating a log in Logtest table with information provided in the form****
rs2.AddNew
rs2("Asset_Type") = Me!Type
rs2("Transfer_Type") = "New purchase"
rs2("Description") = Me!DESCRIPTION
rs2("DELIVERED_TO") = Me!Location
rs2("DELIVERED_BY") = Me!DeliveredBy
rs2("RECEIVED_BY") = Me!Receiver
rs2("RECEIVED_DATE") = Me!Date
rs2.Update
MsgBox "Part information has been updated in the database!"
'clear the controls to add more customers
Call ClearControls
Else
MsgBox "Asset_ID: " & Me!Asset_ID & " already exists.", 48, "ERROR!"
Me!Asset_ID.SetFocus
End If
Else
MsgBox "Serial Number: " & Me!Serial & " already exists.", 48, "ERROR!"
Me!Serial.SetFocus
End If
rs1.Close
rs2.Close
db.Close
End Sub