Hello,
I've been developing Access databases for various work projects since 2016. Right now I am working on a database to simplify some daily inventory reports, part of which involves tracking "aged" daily inventory.
One way I managed to implement this is to adapt Allen Brown's "quantity on hand" code. It works 99% of the time, but that 1% of the time it doesn't work properly is the days where we do have 0-day aged inventory. My adaptation ends up pushing the 0-day down a day or two.
I'd like to either fix the VBA function, or develop a query to eliminate it.
Attached is an Excel file that represents my current tables (AgedInv for receipts, and a Closures table) and the desired result.
Any help is appreciated.
I've been developing Access databases for various work projects since 2016. Right now I am working on a database to simplify some daily inventory reports, part of which involves tracking "aged" daily inventory.
One way I managed to implement this is to adapt Allen Brown's "quantity on hand" code. It works 99% of the time, but that 1% of the time it doesn't work properly is the days where we do have 0-day aged inventory. My adaptation ends up pushing the 0-day down a day or two.
Code:
Function OnHandAged(ProgramId As Variant, RptDate As Variant, AgeDate As Variant) As Long
Dim DB As DAO.Database
Dim RS As DAO.Recordset
Dim SQL As String
Dim CLSD As Long, Inv As Long, Remainder As Long
Set DB = CurrentDb
OnHandAged = 0
' determine total closures
SQL = "SELECT SUM([SumOfPDS]) AS [CLSD] FROM qrySumClosures " & _
"WHERE [RptDate] <= #" & RptDate & "# And [Program] = '" & ProgramId & "'"
Set RS = DB.OpenRecordset(SQL)
If RS.RecordCount > 0 Then
CLSD = Nz(RS!CLSD, 0)
End If
RS.Close
' calculate inventory to date
SQL = "SELECT Program, AgedDate, SUM([PDS]) AS [Sum] FROM AgedInv" & _
" WHERE RptDate <= #" & RptDate & "# And Program = '" & ProgramId & "'" & _
" GROUP BY AgedInv.Program, AgedInv.AgedDate"
Set RS = DB.OpenRecordset(SQL)
' subtract inventory count (PDS)
' from the total closures for each aged date
Do Until RS.EOF
DoEvents
If CLSD > 0 And CLSD <= RS!Sum Then
Remainder = RS!Sum - CLSD
CLSD = 0
ElseIf CLSD = 0 Then
Remainder = RS!Sum
Else
Remainder = Remainder - RS!Sum
If Remainder < 0 Then Remainder = 0
CLSD = CLSD - RS!Sum
End If
If AgeDate = RS!AgedDate Then
OnHandAged = Remainder
Exit Do
End If
RS.MoveNext
Loop
RS.Close
Set RS = Nothing
Set DB = Nothing
End Function
Attached is an Excel file that represents my current tables (AgedInv for receipts, and a Closures table) and the desired result.
Any help is appreciated.