Access VBA Looping through Multidimensional Array

[shogan]

I need help with my code and/or logic. I need to subtract Safety Stock from an Inventory Table by item by Lot#-Location, with greatest Qty first until the Safety stock is depleted.

I can have multiple Inventory items with different Lot# Location Qty combinations.

The only relationship is Item Number

I think I am going wrong with the loop that subtracts the safety stock and then updates the Inventory table. If there is a better way to do this please let me know.

Any help would be greatly appreciated.

    Item       Safety_Stock
    011901        917

    Item	 Location	  Lot	        QOH
    011901       PR501106	REXI0474	3325
    011901       pp46321b	REXI0474	475

 Public Function InventoryUpdate()
    Dim intTot As Long
    Dim i As Integer
    Dim i2 As Integer
    Dim loopCounter As Integer

    'Assign recordsets
    
    'Define recordset to get expected SS data
    Dim rsSS As DAO.Recordset
    Set rsSS = Currentdb.OpenRecordset("SELECT * FROM tbl_ItemxSS")

    'Define recordset to get Inventory data
    'Inventory records ID, Site, PL, Item, Desc, Location, Lot, QOH, QtyAlloc, Created, Expire, Status
    Dim rsInv As DAO.Recordset
    Set rsInv = Currentdb.OpenRecordset("SELECT * FROM tbl_Inventory")
    
    ' get rsSS.recordcount and go back to the beginning
    rsSS.MoveLast
    rsSS.MoveFirst
    'Debug.Print rsSS.RecordCount
    

    ' Need to update Inventory records returned by subtracting SS 
    Dim RA() As Variant
    ReDim RA(0 To rsSS.RecordCount - 1, 0 To 1)

    ' Populate the array with the SS data
    i = 0
    Do Until rsSS.EOF
    'Debug.Print rsSS.Fields(0)
    'Debug.Print rsSS.Fields(1)
        RA(i, 0) = rsSS!Item
        RA(i, 1) = rsSS!Safety_Stock

        If rsSS.RecordCount <> 0 Then
            rsSS.MoveNext
            i = i + 1
            
        End If
    Loop

    intTot = 0
    loopCounter = 0 ' This will ensure we don't check transactions more than once

    Do Until rsInv.EOF
    Debug.Print rsInv.Fields(3)
     Debug.Print rsInv.Fields(7)

        If intTot < rsInv!QOH Then                      'if 0 is less than QOH
            For i = loopCounter To UBound(RA)           'Loop through SS array one by one
                intTot = intTot + RA(i, 1)              'Initialize intTot to be SS Qty
                If intTot <= rsInv!QOH Then             'If SS Qty <= QOH
                    rsInv.Edit                          'Edit Inventory Table
                    rsInv!QOH = rsInv!QOH - intTot      'Subtract SS from QOH
                    rsInv.Update                        'Update that QOH's with new Qty
                    intTot = 0                          'Reset SS qty to 0 since it was all allocated
                    loopCounter = loopCounter + 1       'increase this so we don't double check a transaction
                    Exit For ' exit loop and move to the next SS Qty
                End If
            Next i
        Else
            rsInv.Edit
            rsInv!QOH = rsInv!QOH
            rsInv.Update
            intTot = intTot - rsInv!QOH
        End If
        If rsInv.RecordCount <> 0 Then
            rsInv.MoveNext
        End If
    Loop
End Function

[shogan]

Solution provided on another forum:

Dim rsSS As DAO.Recordset, rsInv As DAO.Recordset
Dim qdf As DAO.QueryDef
Dim intTot As Long, intReduction As Long

Set rsSS = CurrentDb.OpenRecordset( _
        "SELECT * FROM [tbl_ItemxSS]", _
        dbOpenSnapshot)
Set qdf = CurrentDb.CreateQueryDef("", _
        "SELECT * FROM [tbl_Inventory] " & _
        "WHERE [Item]=[pCurrentItem] " & _
        "ORDER BY [QOH] DESC")
Do Until rsSS.EOF
    intTot = rsSS!Safety_Stock
    qdf!pCurrentItem = rsSS!Item  ' set query parameter for this iteration
    Set rsInv = qdf.OpenRecordset(dbOpenDynaset)
    Do Until rsInv.EOF
        intReduction = IIf(rsInv!QOH > intTot, intTot, rsInv!QOH)
        rsInv.Edit
        rsInv!QOH = rsInv!QOH - intReduction
        rsInv.Update
        intTot = intTot - intReduction
        If intTot = 0 Then
            Exit Do
        End If
        rsInv.MoveNext
    Loop
    rsInv.Close
    Set rsInv = Nothing
    rsSS.MoveNext
Loop
Set qdf = Nothing
rsSS.Close
Set rsSS = Nothing

[topher23]

Hurrah for cross-posting! Thanks for posting the answer rather than leaving your post orphaned.