database - How do I loop through certain records, check a query, and conditionally assign field value using VBA? -
database - How do I loop through certain records, check a query, and conditionally assign field value using VBA? -
i trying accomplish following:
use vba loop through table, , assign people seated @ dinner tables using next 3 parameters:
1) individual's priority score.
2) individual's preferences on table seated at.
3) seating capacity of table.
ideally, vba start 1st record of priority 1 group, assign many people can placed in table1, , go on assigning priority 1 individuals according preference, while checking see if preferred tables @ capacity.
after all priority 1 individuals assigned table (given 'table_assignment' value in table object), vba moves priority 2 individuals, , forth.
in database, have next table (table object called 'tbl_assignments'):
recordid | table_assignment | priority | title | preference_1 | preference_2 |... preference_n 001 1 ceo table1 002 1 ceo-spouse table1 003 1 vp table1 table2 004 1 vp-spouse table1 table2 005 2 avp table1 table2 006 2 avp-spouse table1 table2 007 3 chief counsel table1 table2 table_n 008 3 coo table1 table2 table_n
additionally, have created query tells how many vacancies left assignments tables beingness made (query object called 'qry_capacity_sub1'):
tableid | maximum_seating | seats_taken | vacancies table1 4 3 1 table2 4 2 2 table3 4 0 4 table4 4 1 3
i have attempted write vba, loop, accomplish goal of looping through table ('tbl_assignments') , assigning values 'table_assignment' field 1 time command button clicked on form.
update (11/09/2014): updated vba in process now. changes vba reflect jérôme teisseire's suggestion.
the next vba started saw here: looping through table, changing field values
private sub command0_click() dim db dao.database dim rs dao.recordset dim strsql string set db = currentdb() strsql = "select recordid, table_assignment, priority, preference_1, preference_2, preference_3 tbl_assignments priority =1" set rs = db.openrecordset(strsql) on error goto err_handler until rs.eof rs if there seats available @ first preferred table .edit !table_assignment = rs!preference_1 .update .movenext end if if first table preferred has reached capacity, , there seats left in sec preferred table .edit !table_assignment = rs!preference_2 .update .movenext end if '..keep checking each person's preferred tables. if cannot assigned table because preferred tables @ capacity... else .edit !table_assignment = "unassigned" .update .movenext end loop rs.close exit_handler: set rs = nil set db = nil exit sub err_handler: msgbox "you need debug" resume exit_handler end sub
probably qry_capacity_sub1 relies on tbl_assignments , when you're trying query , update @ same time makes access crash.. verify seek replace dlookup conditions false checks
if true ...
just verify rest of code works properly.
also think there logical error in code in dlookup conditions - "tableid='preference_1'" search 'preference_1' string not column value. think must liek "tableid='" + rs!preference_1 + "'", afraid not help well.
i'd suggest cache vacancies per table in-memory dictionary , decrement vacancy each time assign table. code given below. note improve not nest movenext in if sure there no endless loop (this cause of crash).
private sub command0_click() dim db dao.database dim rs dao.recordset dim strsql string dim vacancypertable new scripting.dictionary set db = currentdb() set rsvac = db.openrecordset("select distinct tableid, vacancies qry_capacity_sub1") while not rsvac.eof vacancypertable.add rsvac!tableid, rsvac!vacancies loop rsvac.close strsql = "select recordid, table_assignment, priority, preference_1, preference_2, preference_3 tbl_assignments priority =1" set rs = db.openrecordset(strsql) on error goto err_handler until rs.eof rs if vacancypertable(!preference_1) > 0 .edit !table_assignment = rs.fields(3) .update vacancypertable(!preference_1) = vacancypertable(!preference_1) - 1 elseif vacancypertable(!preference_2) > 0 .edit !table_assignment = rs.fields(4) .update vacancypertable(!preference_2) = vacancypertable(!preference_2) - 1 elseif vacancypertable(!preference_3) > 0 .edit !table_assignment = rs.fields(5) .update vacancypertable(!preference_3) = vacancypertable(!preference_3) - 1 else .edit !table_assignment = "unassigned" .update end if .movenext end loop rs.close exit_handler: set rs = nil set db = nil exit sub err_handler: msgbox "you need debug" resume exit_handler end sub
database vba loops ms-access access-vba
Comments
Post a Comment