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
Related
I'm attempting to write a function that compares the "Pack_Number" fields in two recordsets. My code works fine if they are in numerical order but if pack numbers are added out of order my code doesn't work right and won't recognize that the pack numbers exist.
My Code:
Function Validation()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim rsm As DAO.Recordset
Set db = CurrentDb
Set rs = CurrentDb.OpenRecordset("RetailEntry")
Set rsm = CurrentDb.OpenRecordset("MasterQuery")
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Validate offers have not mailed
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If Not (rs.EOF And rs.BOF) Then
rs.MoveFirst
Do Until rs.EOF = True
If rsm.RecordCount = 0 Or rs.Fields("Pack_Number") <> rsm.Fields("Pack_Number") Then
MsgBox ("All prefixes have mailed for Pack Number " & rs.Fields("Pack_Number") & " If you wish to submit an In-season Markdown Request " _
& "please exit the tool, and submit your request using the In-Season Markdown request file in the CID Request folder")
Exit Function
rs.MoveNext
rsm.MoveNext
Loop
End If
End Function
What I'm trying to do is just have it verify that the pack number they entered from RetailEntry is appearing in the MasterQuery if it is then pass else fail and msgbox pops up.
Any help would be greatly appreciated.
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
I am super new at this and need help. I am trying to send a query as an excel document to specific people contained in a table called "tblRelationship", the email is in a field called "Email". However, there are more people in this table then I want to send to. There is a third field called "RelationshipType" that I need to set to = Accounting
I have been using this code that I found:
Const stDocName As String = "qryPOAccountingReport"
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim stRecipients As String
Set db = CurrentDb()
Set rs = db.OpenRecordset("tblRelationship")
With rs
Do While Not .EOF
stRecipients = stRecipients & ";" & !Email
.MoveNext
Loop
.Close
End With
If Len(stRecipients) > 0 Then
' discard leading ";"
stRecipients = Mid(stRecipients, 2)
DoCmd.SendObject acQuery, stDocName, acFormatXLS, _
stRecipients, , , "Thank You for your purchase"
Else
MsgBox "No recipients to email!"
End If
Set rs = Nothing
Set db = Nothing
And it works great. I just don't understand how to put the "RelationshipType" criteria in there. Can anyone help?
Thank you in advance!
Simply, run a query in your OpenRecrdset() which can take whole tables, stored queries, or SQL Select statements:
Set rs = db.OpenRecordset("SELECT [Email] FROM tblRelationship" _
& " WHERE RelationshipType='Accounting'")
I have an Excel file that exports data into Word. It includes a cover page and grabs the user name ("First.Last") and changes it to "First Last" but I also need to include the user's professional title. This information is housed in an Access table. It has a field called Name and a field called Title. The Name field match exactly to User with no duplicates.
I have tried about eight different methods I've found online to grab this value from the table. The table will never happen to be open so I can't use "CurrentDB()".
I just need to be able to reach into the table in a database, grab the "title" value given that the value of the field "Name" is equal to the value of User (user name from the environment - the person using the excel file).
If it helps, I can provide examples of the different chunks of code I've used so far.
User is the username from the environment
tblPickName is the table I am trying to open
Path is the directory and file where the table is located
tblPickName has 2 fields, Name and Title
I need to grab the Title from this table and set it to my variable "Title" as long as Name equals User. Then I can export the username and title to Word along with the rest of the data.
Dim Path As String
Dim User As String
Dim Title As String
Dim db As DAO.Database
Dim rs As DAO.Recordset
User = Environ("UserName")
User = Replace(User, ".", " ")
User = StrConv(User, vbProperCase)
Path = "Directory\Name.mdb"
Set db = DBEngine.OpenDatabase(Path)
Set rs = db.OpenRecordset("SELECT tblPickAnalyst.Title FROM tblPickAnalyst WHERE [Analyst]='" & User & "'")
Title = rs!Title
rs.Close
db.Close
Set rs = Nothing
Set db = Nothing
docWord.Bookmarks("AnalystName").Range.Text = User
docWord.Bookmarks("AnalystTitle").Range.Text = Title
Try this:
Public Sub JohnTayloristheBest()
Dim conAccess As ADODB.Connection
Set conAccess = New ADODB.Connection
Dim rdsAccess As ADODB.Recordset
Dim strTitle as String
With conAccess
.ConnectionString = "Data Source= **insert filepath here** "
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Open
End With
With rdsAccess
.Open "SELECT tblPickName.Title FROM tblPickName WHERE tblPickName.Name = '" & Environ("username") & "';", conAccess
If Not .EOF And Not IsNull(.fields(0)) Then
strTitle = .fields(0)
Else
Msgbox "Error: No record in the database for " & Environ("username")
End If
.Close
End With
conAccess.Close: conAccess = Nothing
End Sub
Be sure to select the correct references by doing this: http://msdn.microsoft.com/en-us/library/windows/desktop/ms677497(v=vs.85).aspx
Also, this is my first answer ever written on this site (or any other for that matter), so be kind.
Try this:
Public Function getTitle(name As String)
Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = DBEngine.OpenDatabase("E:\Temp\Database.mdb")
Set rs = db.OpenRecordset("SELECT Title FROM tblPickName WHERE Name='" & name & "'")
If rs.RecordCount > 0 Then
getTitle = rs!Title
End If
rs.Close
db.Close
End Function
Ensure read access on table tblPickName (for Administrator)
Here is the final solution. Thank you to everyone who helped!
Dim Path As String
Dim User As String
Dim Title As String
Dim db As DAO.Database
Dim rs As DAO.Recordset
User = Environ("UserName")
User = Replace(User, ".", " ")
User = StrConv(User, vbProperCase)
Path = "Directory\FileName"
Set db = DBEngine.OpenDatabase(Path)
Set rs = db.OpenRecordset("SELECT tblPickAnalyst.Title FROM tblPickAnalyst WHERE [Analyst]='" & User & "'")
Title = rs!Title
rs.Close
db.Close
Set rs = Nothing
Set db = Nothing
docWord.Bookmarks("AnalystName").Range.Text = User
docWord.Bookmarks("AnalystTitle").Range.Text = Title
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.