Table for priorities? - sql

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.

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

Adding/Updating a sql table in VBA

I am trying to make it so that Query 1 inserts into 1 of the 3 fields based on whether the task value (grabbed from another table) is selected (true or false check box). This part works.
Query 2 is supposed to update the other 2 fields that are empty to the values in a combo box. This part is not working. Syntactically it seems correct and it isn't crashing. But I just don't think it is reading it in the first place.
All this is supposed to be accomplished via 1 button click.
Query 1:
Sub DBInsert_SkillMatrix()
sSQL = "Insert into tblSkillMatrix (Task) Select Task from tblTask WHERE Selected = true"
Set db = CurrentDb
db.Execute (sSQL)
db.Close
End Sub
Query 2:
Sub DBUpdate_SkillMatrix()
Dim db As DAO.Database
sSQL = "UPDATE tblSkillMatrix SET Skill = '" & Me.cboAST_Skill & "', Requirement = '" & Me.cboAST_Requirement & "' WHERE Skill = ''"
Set db = CurrentDb
Debug.Print (sSQL)
db.Execute (sSQL)
End Sub
The error is in the wrong where clause. It should be with ISNULL. Here is a guidance how to use it - https://msdn.microsoft.com/en-us/library/ms184325.aspx

SetFocus is getting ignored - Why?

I have 2 fields - txtTR1_Unit and cmbTR2_Unit. Together, these 2 fields represent the total UNIT.
cmbTR2_Unit has a list of unique values that when selected - txtTR1_Unit automatically gets the related value.
I've created a function called Tier1from2 - that accepts a 'string' and returns the related Tier1 value.
So when I update cmbTR2_Unit in my After_Update event, I'd like to automatically tab to the next field. - Another combo box. I figured that I shouldn't need to set any focus, because it would automatically go to the next field after updating.
txtTR1 gets updated just as expected from my Function, but then it just sits there and won't go to the next field. So I have attempted to 'SetFocus' to the next field after the update.
Still no go. What did I miss??
Private Sub cmbTR2_UNIT_AfterUpdate()
If Len(Me.cmbTR2_UNIT.Value) <> 0 Then
Me.txtTR1_UNIT.Value = Tier1From2(Me.cmbTR2_UNIT.Text)
'cmb_CostCenter.setfocus - 'this doesn't seem necessary - but it doesn't work anyway.
End If
End Sub
As a test I tried removing the function "Tier1From2(Me.cmbTR2_UNIT.text)" simply hard coding the word 'RESULT' in txtTR1_UNIT and it works without a hitch. I know I used to write a more simple function but I haven't touched VBA in awhile - How can I simplify this function:
Private Function Tier1From2(strTier2 As String) As String
Dim qdf As DAO.QueryDef
Dim db As DAO.Database
Dim strQry As String
Dim rs As Recordset
Set db = CurrentDb
Set qdf = db.QueryDefs("qUNIT_HUB")
strQry = "SELECT Tier1_Unit, Tier2_Unit " & _
" FROM LTBL_Cost_Collector " & _
" GROUP BY Tier1_Unit, Tier2_Unit " & _
" HAVING (((Tier2_Unit) = '" & strTier2 & "'));"
qdf.SQL = strQry
db.QueryDefs.Refresh
Set rs = db.OpenRecordset(strQry)
Tier1From2 = rs![Tier1_Unit]
Set db = Nothing
Set qdf = Nothing
Set Recordset = Nothing
End Function
It turns out that something in this function was causing the field and form to loose focus. db.QueryDefs.refresh perhaps? The solution was to update my Function as follows
Private Function Tier1From2(strTier2 As String) As String
Dim rs As DAO.Recordset
Dim db As DAO.Database
Dim strSQL As String
Dim strTier1 As String
Set db = CurrentDb
strSQL = "SELECT Tier1_Unit, Tier2_Unit " & _
" FROM LTBL_Cost_Collector " & _
" GROUP BY Tier1_Unit, Tier2_Unit " & _
" HAVING (((Tier2_Unit) = '" & strTier2 & "'));"
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
strTier1 = rs!Tier1_Unit
Set rs = Nothing
Set db = Nothing
Tier1From2 = strTier1
End Function
This worked without a hitch.

When inserting data from a query to a table, does the query run for each record inserted?

I'm inserting data problematically into tables. When I do this from another table, it's swift, only slowed very slightly if there are a lot of records. Even then, it's a matter of seconds.
When I insert from a query to a table, it goes into minutes - roughly a minute for every 1,000 records inserted.
The source query itself, when just run as a select query, takes maybe 1 - 2 seconds. Is the query running for every record that's inserted? I'd hoped that it would run once for the whole data set. Or is there something else that's causing the function to run so slowly when compared to inserting "flat" data from another table.
The VBA I'm using is fairly innocuous:
CurrentDb.Execute "SELECT [Extra Value Concatenation].* _
INTO [" & strTableName & "] FROM [Extra Value Concatenation];"
and the source query is below - it uses Allen Browne's Concatenate function.
SELECT [Extra Fields - Fee Protection Insurance Concatenate].ContactID,
ConcatRelated('[Fee Protection Insurance]',
'[Extra Fields - Fee Protection Insurance Concatenate]',
'ContactID = ' & [ContactID])
AS [Fee Protection Insurance]
FROM [Extra Fields - Fee Protection Insurance Concatenate];
EDIT: In answer to Fionnuala's comment, but I couldn't format it properly in the comments.
Using fictional data, here's roughly what I want.
T1 contains client records.
ContactID Name
1 Example Limited
2 Another Company Limited
T2 contains extra fields. ContactID is there as a foreign key, and may be duplicated if multiple records are held.
ContactID FieldValue
1 Value 1
1 Value 2
2 Value 3
2 Value 4
2 Value 5
When I left join the tables, the duplicates from T2 show up, so I get
ContactID Name FieldValue
1 Example Limited Value 1
1 Example Limited Value 2
2 Another Company Limited Value 3
2 Another Company Limited Value 4
2 Another Company Limited Value 5
when what I want is
ContactID Name FieldValue
1 Example Limited Value 1; Value 2
2 Another Company Limited Value 3; Value 4; Value 5
Hence concatenating the data in a temporary table seemed like a good idea, but is slowing everything down. Is there another way I should be looking at my query?
I have written a pretty basic module that should accomplish this for you very quickly compared to your current process. Note you will need to re-name your project to something other than "Database" on the project navigation pane for this to work
I have assumed that table1 and table2 are the same as you have above
table3 is simply a list of all records in table 1 with a blank "FieldValues" field to add
the required "value1, value2" etc. This should result in Table3 being populated with your desired result
IMPORANT: For anyone using recordset .edit and .update functions make sure you remove record level locking in the access options menu, it can be found under the "client settings" section of Access options, failing to do so will cause extreme bloating of your file as access will not drop record locks until you compact and repair the database. This may cause your database to become un-recoverable once it hits the 2gb limit for windows.
Function addValueField()
'Declarations
Dim db As Database
Dim rs1 As DAO.Recordset
Dim rs2 As DAO.Recordset
Dim qry As String
Dim value As String
Dim recordcount as Long
Set db = CurrentDb()
'Open a select query that is a join of table 1 and table 2
'I have made Contact ID a foreign key in the second table
qry = "SELECT Table1.[Contact ID], Table1.Name, Table2.FieldValue FROM Table1 INNER JOIN Table2 ON Table1.[Contact ID] = Table2.[Contact ID(FK)] ORDER BY [Contact ID];"
Set rs1 = db.OpenRecordset(qry, dbOpenDynaset)
'Table 3 was filled with each record from table1, with a 3rd "Field Value" field to
'be filled with your Value 1, Value 2 etc.
qry = "SELECT * FROM Table3 ORDER BY [Contact ID]"
Set rs2 = db.OpenRecordset(qry, dbOpenDynaset)
'Ensure you have enough file locks to process records
recordcount = rs1.recordcount
DAO.DBEngine.SetOption DAO.dbMaxLocksPerFile, recordcount + 1000
rs1.MoveFirst
rs2.MoveFirst
'Here we test to see if "Name" is the same in both recordsets, if it is, add the FieldValue
'to the FieldValue in Table3, otherwise move to the next record in table 3 and compare again
Do While Not rs1.EOF
If IsNull(rs2![FieldValue]) = True Then
If rs2![FieldValue] = "" Then
rs2.Edit
rs2![FieldValue] = rs1![FieldValue]
rs2.Update
rs1.MoveNext
Else
rs2.Edit
rs2![FieldValue] = rs2![FieldValue] & "; " & rs1![FieldValue]
rs2.Update
rs1.MoveNext
End If
Else
rs2.MoveNext
End If
Loop
rs1.close
rs2.close
db.close
set db = nothing
set rs1 = nothing
set rs2 = nothing
End Function
You are using a user defined function (UDF) ConcatRelated, so the UDF runs for each record, otherwise, usually Access SQL works in the normal way.
Building on pegicity's answer, my eventual code was:
Option Compare Database
Sub Concatenate(strTableToConcatenate As String, strFieldToConcatenate As String, strIDField As String)
Dim rsSource As DAO.Recordset
Dim rsDestination As DAO.Recordset
Dim qry As String
Dim strSourceTable As String
Dim i As Integer
Dim strFieldName As String
Dim strValue As String
Dim intConcatenateID As Integer
Dim intSortID As Integer
strSourceTable = strTableToConcatenate & " (Concatenate)" 'Creates a duplicate copy of the table to be concatenated and empties the original table'
DeleteTable (strSourceTable)
DoCmd.CopyObject , strSourceTable, acTable, strTableToConcatenate
qry = "DELETE FROM [" & strTableToConcatenate & "]"
CurrentDb.Execute (qry)
qry = "ALTER TABLE [" & strTableToConcatenate & "] ALTER COLUMN [" & strFieldToConcatenate & "] memo" 'Changes the DataType of the field to be concatenated to Memo, as the result may be considerably longer than the original data'
CurrentDb.Execute (qry)
i = 0
intCurrentID = 0
qry = "SELECT * FROM [" & strSourceTable & "] ORDER BY [" & strIDField & "], [" & strFieldToConcatenate & "]"
Set rsSource = CurrentDb.OpenRecordset(qry, dbOpenDynaset)
qry = "SELECT * FROM [" & strTableToConcatenate & "]"
Set rsDestination = CurrentDb.OpenRecordset(qry, dbOpenDynaset)
For Each fld In rsSource.Fields 'Finds the column number of the fields you are sorting by and concatenating from your source table.'
strFieldName = rsSource.Fields(i).Name
If strFieldName = strFieldToConcatenate Then
intConcatenateID = i
ElseIf strFieldName = strIDField Then
intSortID = i
End If
i = i + 1
Next
If rsSource.recordcount <> 0 Then
rsSource.MoveFirst
intCurrentID = rsSource.Fields(intSortID).Value
strConcatenateValue = ""
While Not rsSource.EOF 'The source recordset is sorted by your designated sort field, so any duplicates of that field will be next to each other. If the row below has the same id as the row above, the sub continues to build the concatenated value. If the row changes, it adds the concatenated value to the destination record set.'
If intCurrentID = rsSource.Fields(intSortID).Value Then
strConcatenateValue = strConcatenateValue & "," & rsSource.Fields(intConcatenateID).Value
rsSource.MoveNext
Else
rsDestination.AddNew
i = 0
If Len(strConcatenateValue) > 0 Then
strConcatenateValue = Right(strConcatenateValue, Len(strConcatenateValue) - 1)
End If
For Each fld In rsSource.Fields
strFieldName = rsSource.Fields(i).Name
If strFieldName = strFieldToConcatenate Then
strValue = strConcatenateValue
ElseIf strFieldName = strIDField Then
strValue = intCurrentID
Else
strValue = rsSource.Fields(i).Value
End If
rsDestination.Fields(strFieldName) = "" & strValue & ""
i = i + 1
Next
rsDestination.Update
intCurrentID = rsSource.Fields(intSortID).Value
strConcatenateValue = ""
End If
Wend
End If
rsSource.Close
rsDestination.Close
Set rsSource = Nothing
Set rsDestination = Nothing
End Sub

How to set controlsource of a textbox from SQL

I have a subform bound to a SQL statement. Inside the subform, I have a few text boxes bound to the fields of this SQL. However, I have another text box that needs to be bound to a field from a different SQL statement with criteria from the first one. My code looks like below:
Dim subform As Object
Dim formFilter As String
formFilter = "SELECT * FROM my_table_1"
Set subform = Me!my_subform.Form
subform.RecordSource = formFilter
subform.field1.ControlSource = "tb1f1"
subform.field2.ControlSource = "tb1f2"
...
subform.f3.ControlSource = "= SELECT TOP 1 tb2f3 FROM my_table_2 WHERE tb2f1 = '" & [tb1f1] & "' AND tb2f2 = '" & [tb1f2] "' ORDER BY tb2f4"
I cannot use a DLOOKUP function here directly, because I need to sort the table result.
Thanks in advance for your help.
I think I would simply create a little function to go get the result you want. It would probably be best to simply rework DLookup in your own function and add sort but I won't do that here.
First the form code. Notice I am not setting the recordsource, just the value which may not be what you want.
subform.f3 = fGet_tb2f3([tb1f1], [tb1f2])
Then the function code (put in your own error handling)
Public Function fGet_tb2f3(tblf1 as String,tblf2 as String) as String
Dim rst as dao.recordset
Dim db as database
set db = currentdb
set rst = db.openrecordset("SELECT TOP 1 tb2f3 FROM my_table_2 WHERE tb2f1 = '" & tb1f1 & "' AND tb2f2 = '" & tb1f2 "' ORDER BY tb2f4",dbopensnapshot
if not rst is nothing then
if not rst.eof then fGet_tb2f3 = rst!tb2f3
rst.close
set rst = nothing
end if
db.close
set db = nothing
end Function
You can't bind controls on the same form to 2 different recordsets. The only thing you could do is pull data from 2 different recordsets, but that's probably not the best way to do anything.
In order to do that, you'd have to create a second recordset and grab that value in it. Something like:
Dim db as Database
Dim rec as Recordset
Set db = CurrentDB
Set rec = db.OpenRecordset("SELECT TOP 1 tb2f3 FROM my_table_2 WHERE tb2f1 = '" & [tb1f1] & "' AND tb2f2 = '" & [tb1f2] "' ORDER BY tb2f4")
Me.MyControlName = rec(0)