Form with multiple subforms - synchronize record change of subforms - ms-access

I have a form (F_ptselect) with multiple subforms (F_s1, F_s2, F_s3). On the main form I have a combo box that allows me to choose an integer identifier (i.e., ID = 1001, id = 1002, id = 1003, id = 1004, etc.). The subforms are also all linked by ID using "Link Master Fields" and "Link Child Fields". I've found and modified vba that allows me to choose an ID (say 1001) from the combo box on F_ptselect, and subsequently pull up all the data for ID = 1001 on F_s1, F_s2, and F_s3.
Here's that vba:
Private Sub find_ID_AfterUpdate()
' Find the record that matches the control.
Dim rs As Object
Set rs = Me.Recordset.Clone
rs.FindFirst "[ID] = " & Me![find_ID] & ""
If Not rs.EOF Then Me.Bookmark = rs.Bookmark
End Sub
Now, for each ID there are multiple records (i.e., ID=1001 and day=1, ID=1001 and day=2, ID=1002 and day=1, ID=1002 and day=2 etc.). I'd like to be able to have a combo box or button or something that allows me to synchronize the ability to cycle through these records of a single ID. So if I select ID 1001 from the F_ptselect combo box, I'd like to see F_s1, F_s2, and F_s3 for ID 1001, day 1. Then I'd like to be able to change to day 2 for ID 1001 quickly using a combo box selection, button or something. Currently, I'd have to go to the record arrows at the bottom of each subform to change the record. Each row of data has a primary key (let's call it KEY) as well. So a query row or table row would look like:
KEY
ID
Day
1
1001
1
2
1001
2
3
1002
1
4
1002
2

Options:
RecordsetClone/Bookmark method for each subform
applied by Gustav sample Access db in https://www.experts-exchange.com/articles/18107/Synchronizing-Multiple-Subforms-in-Access.html?preview=cUa6D5QxDFA%3D
set each subform Filter and FilterOn properties
parameterized query as RecordSource for each subform
I always name subform container different from the form it holds, like ctrFS1. For option 2, consider:
Sub cbxDay_AfterUpdate()
Dim strF As String
With Me
strF = "[Day]=" & .cbxDay
.ctrFS1.Form.Filter = strF
.ctrFS1.Form.FilterOn = True
.ctrFS2.Form.Filter = strF
.ctrFS2.Form.FilterOn = True
.ctrFS3.Form.Filter = strF
.ctrFS3.Form.FilterOn = True
End With
End Sub
If you name each subform container like: ctrFS1, ctrFS2, ctrFS3, consider:
Dim x As Integer
With Me
For x = 1 to 3
.Controls("ctrFS" & x).Form.Filter = "Day=" & .cbxDay
.Controls("ctrFS" & x).Form.FilterOn = True
Next
End With

Here's the final code (based on the answer from June7) for any interested. The "Day" field is actually a string in my tables so that's why the concatenation syntax is for a string.
Private Sub find_day_AfterUpdate()
Dim strF1 As String
With Me
strF1 = "[Day]='" & .find_day & "'"
.F_s1.Form.Filter = strF1
.F_s1.Form.FilterOn = True
End With
Dim strF2 As String
With Me
strF2 = "[Day]='" & .find_day & "'"
.F_s2.Form.Filter = strF2
.F_s2.Form.FilterOn = True
End With
Dim strF3 As String
With Me
strF3 = "[Day]='" & .find_day & "'"
.F_s3.Form.Filter = strF3
.F_s3.Form.FilterOn = True
End With
End Sub

Related

Counting and returning duplicates from Listbox

I have a listbox (Listbox1) in MS Access 2016 with 1 column - ActualDate.
This column contains numerous dates, some of which are duplicated.
The rowsource for this listbox is
Set rs = CurrentDb.OpenRecordset("SELECT q.ActualDate FROM TBLQUOTESNEW q WHERE q.ActualDate >= #12/01/2017# order by q.ActualDate")
I need to populate another listbox (Listbox2) on the same form, that has 2 columns - ActualDate and Count - with Count being the number of selected rows from Listbox1 containing the date.
So Listbox1 could be :-
13/01/2017
13/01/2017
14/01/2017
14/01/2017
If all 4 rows were selected, Listbox2 should return
13/01/2017 2
14/01/2017 2
I'm not sure on the best method to achieve this. I've been able to create an array with the unique dates, but from there I am stumped.
You can use the following subroutine:
Public Sub MoveListBoxItems(lstDestination As ListBox, lstSource As ListBox)
Dim intListItem As Long
Dim lastItem As String
Dim itemAmount As Long
'Set these using the property pane, then remove them from the VBA
lstDestination.RowSource = ""
lstDestination.RowSourceType = "Value List"
lstDestination.ColumnCount = 2
For intListItem = 0 To lstSource.ListCount - 1 'iterate through the whole list
If lstSource.Selected(intListItem) Then 'If the item is selected
If lstSource.ItemData(intListItem) = lastItem Then 'If the current item is equal to the last one
itemAmount = itemAmount + 1 'Increment the amount by 1
Else
If itemAmount <> 0 Then 'If it isn't a non-occuring list item (first iteration
lstDestination.RowSource = lstDestination.RowSource & """" & lastItem & """;""" & itemAmount & """;"
End If 'Add the item
lastItem = lstSource.ItemData(intListItem) 'Last item = current item, amount = 1
itemAmount = 1
End If
End If
Next intListItem
If itemAmount <> 0 Then 'If it isn't a non-occuring list item
lstDestination.RowSource = lstDestination.RowSource & """" & lastItem & """;""" & itemAmount & """;"
End If 'Add the last item
End Sub
Call it like this: MoveListBoxItems Me.Listbox2, Me.Listbox1
Note that it carries some assumptions, namely: the list must be ordered, the list must not contain any quotes (else you will need to add quote escaping)
I would use a subform instead if listbox. Subform based on temporary table with additional column "Selected", user selects records using checkboxes. In this case will be very easy to display second listbox or subform based on grouping query from temporary table

Find Lowest Value in Columns Access 2010

I have a table in Access 2010 that has 3 separate priority fields. I have a sub that looks through the columns, finds the smallest number, and puts it in an Overall Priority field.
Ex.
SubProjNo | GOPri | StrPri | SOPri
--------+-----------+----------+------------------
1234-12-01 | 100 | 7 | 61
1234-12-02 | | 18 | 2
1234-12-03 | 51 | |
ProjNo: 1234-12-00 Overall_Priority:2
I originally had the code under Private Sub Form_Current() but it slowed the program down way too much, so I moved it to an AfterUpdate for the subform that the table is in.
Private Sub MFWorkProjectssubform_AfterUpdate()
Dim MinGOPri As Variant
Dim MinStrPri As Variant
Dim MinSOPri As Variant
MinGOPri = DMin("[GOPri]", "[WorkProjects]", "WorkProjects.PROJNO = Activity.PROJNO")
MinStrPri = DMin("[StrPri]", "[WorkProjects]", "WorkProjects.PROJNO = Activity.PROJNO")
MinSOPri = DMin("[SOPri]", "[WorkProjects]", "WorkProjects.PROJNO = Activity.PROJNO")
Overall_Priority = IIf(((IIf([MinGOPri] < [MinStrPri], [MinGOPri], [MinStrPri])))
< [MinSOPri], ((IIf([MinGOPri] < [MinStrPri], [MinGOPri], [MinStrPri]))), [MinSOPri])
End Sub
The problem is, now, all the columns are cleared and only the largest value is left. Any suggestions for how to get this to work, or how to speed it up if I put it back in Form_Current would be really appreciated.
You don't need all this. For the Overall_Priority textbox use this expression as ControlSource:
=IIf(((IIf([GOPri]<[StrPri],[GOPri],[StrPri])))<[SOPri],((IIf([GOPri]<[StrPri],[GOPri],[StrPri]))),[SOPri])
Edit for Null and reduced:
=IIf(IIf(Nz([GOPri],9999)<Nz([StrPri],9999),Nz([GOPri],9999),Nz([StrPri],9999))<Nz([SOPri],9999),IIf(Nz([GOPri],9999)<Nz([StrPri],9999),Nz([GOPri],9999),Nz([StrPri],9999)),Nz([SOPri],9999))
Use this as a fourth column; name it, say, RowMin.
Then, in the footer, use =Min([RowMin]) as the controlsource for your totals box.
How about using recordsets, is this an option ?
Dim rst As Object
Dim minValue As Integer
Dim fieldCounter As Long
Dim minPriority as Long
minPriority = 9999
Set rst = Me.recordsetclone
With rst
.MoveFirst
While Not .EOF
For fieldCounter = 0 To .Fields.Count-1
if(.Fields(fieldcounter).name = "GOPri" or .Fields(fieldcounter).name = "StrPri" or .Fields(fieldcounter).name = "SOPri" ) then
Debug.print "Now you are checking : " &.Fields(fieldcounter).Name & " with value : " & .Fields(fieldcounter) & " Current minPriority = " & minPriority
If len(Nz(.Fields(fieldCounter),"")) > 0 Then
If .Fields(fieldCounter) < minPriority Then minPriority = .Fields(fieldCounter)
End If
End if
Next
.MoveNext
Wend
End With
Set rst = Nothing
Overall_Priority = minPriority
Maybe you need to adjust the fieldCounter to match your Table structure
The fields are counted from 0 -->.... according to your question.
Fields(0) = SubProjNo
Field(1) = GoPRi
If you want this column to always be a function of the other three fields, then you could create a calculated field to the table. The help documents can show you how; also this article gives directions:
https://support.office.com/en-us/article/Add-a-calculated-field-to-a-table-14a60733-2580-48c2-b402-6de54fafbde3
Generally you would define a new field on the table and set it's formula to the maximum of the other three fields. Then any time the calculated field is referenced it will always give you the maximum of them.
The other option is to just not worry about saving the field at all at the time of data entry and simply create a view that adds a field defined to be the maximum of the three values.

AfterUpdate combobox find and replace

I'm trying to figure out how to use AfterUpdate on a combo box to have it find a record from table "Userdata" where field "Recall_position" equals "1" and replace it with "0".
Then find the record selected in the combobox (that it was updated to) and in "Userdata" under "Recall_position" put the number "1"
Like this?
Private Sub cmbTest_AfterUpdate()
CurrentDb.Execute "update Userdata set Recall_position = 0 where Recall_position = 1"
CurrentDb.Execute "update Userdata set Recall_position = 1 where ID = " & Me.cmbTest.Column(0)
End Sub
The first query updates all records with Recall_position = 1 to Recall_position = 0.
The second query updates the record with the ID in the first column of the selected item in the combo box to Recall_position = 1.
(I assumed that it's a numeric value and that the column in the table is called ID)
So using that code I have
Private Sub Combo1_AfterUpdate()
CurrentDb.Execute "UPDATE Userdata SET Recall_position = 0 WHERE Recall_position = 10"
CurrentDb.Execute "UPDATE Userdata SET Recall_position = 10 WHERE Lastname = '" & Me.Combo1.Column(1) & "'"
End Sub
Which does clear out the 10 and updates the right row to
10 as well. However, it is also updating a second row with a random number in the Lastname

Filter parents on which children are selected

I have a table with products and a table with components. Each product has many components, so they are joined by a 'bundles' table.
tblProducts
PID, Description
1, Alpha
2, Bravo
3, Charlie
tblComponents
CID, Description, Category
11, Apple, Cat1
12, Banana, Cat2
13, Orange, Cat3
tblBundles
PID, CID
1, 11
1, 12
1, 13
2, 12
I need to create a form with several listboxes (based on the tblComponents.Category) that will allow me to end up with a filtered list of products. e.g. choose Banana and be left with Product 1 and 2. Then choose Orange and be left with Product 1.
How can I go about getting this?
in case you want to create cascading comboboxes you can proceed in this way:
cmbComp is the Father combobox, cmbProd is the child populated basing on the component selected.
in the AfterUpdate event of cmbComp you must create the Record source string to populate the 2nd combo.
Private Sub cmbComp_AfterUpdate()
Dim qdf As QueryDef, strSQL As String
Dim i As Integer
Dim qryName As String
'-------------------------------------------------
' Delete all combobox items
'-------------------------------------------------
Me.cmbProd.RowSource = ""
Me.cmbProd.Requery
'-------------------------------------------------
' Define a name for the query
'-------------------------------------------------
qryName = "qryProducts"
'-------------------------------------------------
' Delete query if already existing
'-------------------------------------------------
For Each qdf In CurrentDb.QueryDefs
If qdf.Name = qryName Then
CurrentDb.QueryDefs.Delete qryName
End If
Next qdf
'-------------------------------------------------
' Create a query to use as a RowSource
'-------------------------------------------------
strSQL = "SELECT tbBundles.PID, " & _
"DlookUp(""Product"",""tbProducts"",""PID=""+cstr([tbBundles.PID])) " & _
"AS Product FROM tbBundles WHERE CID = " + CStr(Me.cmbComp)
Set qdf = CurrentDb.CreateQueryDef(qryName, strSQL) ' Create a query (check in the Navigation Pane)
Set qdf = Nothing ' Destroy the object qdf
'-------------------------------------------------
' Set up the child combo-box
'-------------------------------------------------
With Me.cmbProd
.ColumnCount = 2
.ColumnWidths = "0;2,54" ' Show Product as item of the list
.RowSource = "qryProducts" ' Set query as rowsource
.Requery
End With
End Sub

Type mismatch error when comparing listboxes

Dim lastcomp As String
Dim qty As Integer
Dim rs As New ADODB.Recordset
rs.Open "select Prem1Item,Prem1Qty from [TU FAR Before VB] order by Prem1Item", accCon
Do While Not rs.EOF
If Not IsNull(rs(0).Value) Then
If rs(0).Value <> "n/a" Then
If rs(0).Value <> "" Then
premlist.AddItem rs(0).Value & Format(rs(1).Value, "00")
End If
End If
End If
rs.MoveNext
Loop
rs.Close
Dim i As Integer
Dim j As Integer
i = 1
For i = 1 To premlist.ListCount
For j = 1 To finallist.ListCount
**If Not finallist(j) = premlist(i) Or finallist(j) = "" Then**
finallist.AddItem premlist(i)
End If
Next j
Next i
AccessConnection ("Close")
End If
I am trying to take the records and pull all of the items in Prem1Item and condense then down to not show duplicates and also get the amount from Prem1Qty and show the total of each item it finds. I was trying to put them in these listboxs and then export them to a table that has 2 columns (Premium and Sum)
I am getting error 13 Type mismatch highlighting the area I have put in Bold ("If Not finalist(j) = premlist(i) Or finalist(j) = "" Then"). My plans were to get that list populated and then fill the table to generate my report with.
A list box object does not allow you to retrieve row values with an index value, like you would for an array, or a VBA Collection, or a recordset Fields collection, and so on.
There is probably a better way to say that, but I don't know how. But attempts such as the following will throw that "Type Mismatch" error ...
Debug.Print Me.finallist(1)
Debug.Print TypeName(Me.finallist(1))
If you want to retrieve the bound column value from each of the list box's rows, use the ItemData property.
Dim i As Long
For i = 0 To (Me.finallist.ListCount - 1)
Debug.Print Me.finallist.ItemData(i)
Next
Debug.Print "done"
I think you should try adding the .value to your comparrison e.g.
finallist(j).value = premlist(i).value