VBA Update routine not working correctly

[skydivetom]

Hello:

I'd like to get some assistance with modifying a simple VBA update routine. Allow me to provide some background first.

Process:
- Attached DB "Example" includes 2 tables: [tbl_MISHAP] and [tbl_PERSON]
- Open form "F01_MainMenu" and click on command button "Update [tbl_MISHAP] ". This will execute the VBA (in module "01_BusinessRule") and update the table accordingly.

Current Issue:
a. At this time, however, the field [MSHP_ACCOUNTING_ORG_ID] and [MSHP_CONVENING_AUTHORITY_ID] are updated incorrectly though. I illustrated both incorrect and correct values in attached XLS snapshot.
b. Let's review attached JPG. I copied the table values into Excel IOT to reference cell range (for validation purposes only).
c. Cell range C3 : D13 show the updated value in table [tbl_MISHAP]. Again, per a), the current VBA update routine results in incorrect values.
d. Cell range H3:I13 show what I would like the values to be after the execution of the update routine.

Additional info:
1. Both tables contain field [MSHP_LEGACY_REPORT_NUMBER]. Field values are distinct.
2a. In the example, both tables are sorted in same ASC order by [MSHP_LEGACY_REPORT_NUMBER].
2b. Please note that in the actual data set, the order may NOT be in sync though. So while [MSHP_LEGACY_REPORT_NUMBER] = e.g., "42158008120149" is record # 6 in both example tables, it may be record #6 in [tbl_MISHAP] and record #71 in table [tbl_PERSON] in the actual data set.
2c. So, based on 2b, we can not rely on the same sequential "record #" when going through the DoWhile loop.
3. Field [ID] is indexed; however, the values for [ID] are different across the 2 tables.

Current VBA:

Sub UPDATE()
  
    Dim db As DAO.Database
    Dim rsm As DAO.Recordset
    Dim rsp As DAO.Recordset
    Dim sqlqry As String
    
    Set db = CurrentDb
    Set rsp = db.OpenRecordset("tbl_PERSON")
    Set rsm = db.OpenRecordset("tbl_MISHAP")
    
    Do While Not rsm.EOF
    
    rsm.Edit

        'Next 2 lines result in incorrect values:
        rsm!MSHP_CONVENING_AUTHORITY_ID = rsp!PERS_ASSIGNED_ORG_ID
        rsm!MSHP_ACCOUNTING_ORG_ID = rsp!PERS_ASSIGNED_ORG_ID


        'What it should be instead:
        'Update [tbl_MISHAP].[MSHP_CONVENING_AUTHORITY_ID] AND [tbl_MISHAP].[MSHP_ACCOUNTING_ORG_ID] ...
        '... with [tbl_PERSON].[PERS_ASSIGNED_ORG_ID] ...
        '... where [tbl_MISHAP].[MSHP_LEGACY_REPORT_NUMBER] = [tbl_[PERSON].[MSHP_LEGACY_REPORT_NUMBER]

    rsm.UPDATE
    rsm.MoveNext
    Loop
    
End Sub

Current Issue (cont):


- As illustrated in the JPG, the current DoWhile loop incorrectly updates the values for fields [tbl_MISHAP].[MSHP_CONVENING_AUTHORITY_ID] and [tbl_MISHAP].[MSHP_ACCOUNTING_ORG_ID].

What I would like to achieve:
- Modify the existing VBA routine so that both fields [tbl_MISHAP].[MSHP_CONVENING_AUTHORITY_ID] AND [tbl_MISHAP].[MSHP_ACCOUNTING_ORG_ID] are updated with [tbl_PERSON].[PERS_ASSIGNED_ORG_ID] where [tbl_MISHAP].[MSHP_LEGACY_REPORT_NUMBER] = [tbl_[PERSON].[MSHP_LEGACY_REPORT_NUMBER].
- How can this be accomplished? Can DLookup be used? If yes, how?

[Gicu]

Hi Tom,
Yes, you can use dLookup to update, so no need for the second recordset. Or you can use a second recordset as you have it now but you need to move it inside the loop on the first one and add the criteria:

Dim db As DAO.Database
    Dim rsm As DAO.Recordset
    Dim rsp As DAO.Recordset
    Dim sqlqry As String
    
    Set db = CurrentDb
    'Set rsp = db.OpenRecordset("tbl_PERSON")
    Set rsm = db.OpenRecordset("tbl_MISHAP")
    
    Do While Not rsm.EOF
    
    rsm.Edit
      Set rsp = db.OpenRecordset("SELECT * FROM tbl_PERSON WHERE [tbl_[PERSON].[MSHP_LEGACY_REPORT_NUMBER]='" & rsm![MSHP_LEGACY_REPORT_NUMBER] & "'") 'I believe the legacy report is text, remove the quotes if number
        'Next 2 lines result in incorrect values:
        rsm!MSHP_CONVENING_AUTHORITY_ID = rsp!PERS_ASSIGNED_ORG_ID
        rsm!MSHP_ACCOUNTING_ORG_ID = rsp!PERS_ASSIGNED_ORG_ID




        'What it should be instead:
        'Update [tbl_MISHAP].[MSHP_CONVENING_AUTHORITY_ID] AND [tbl_MISHAP].[MSHP_ACCOUNTING_ORG_ID] ...
        '... with [tbl_PERSON].[PERS_ASSIGNED_ORG_ID] ...
        '... where [tbl_MISHAP].[MSHP_LEGACY_REPORT_NUMBER] = [tbl_[PERSON].[MSHP_LEGACY_REPORT_NUMBER]


    rsm.UPDATE
    rsm.MoveNext
    Loop

Cheers,

[skydivetom]

BRILLIANT!!!! Thanks for the help, Vlad.

[skydivetom]

Vlad -- in opened a new (related) thread at the following URL: VBA Update Routine with Varying Processing Times (accessforums.net)

As always, I'd welcome your thoughts/suggestions... thank you!!!