Pardon the delay in getting this posted. It's quite a bit. Individually,
running this on just one or a few PNs works, just not the entire inventory
log full (4500+ items).
Forms involved:
Stock Location List - form that lists various locations that stock of an
item can be with quantity of item at that location
Stock Locations Move Form - just a hidden form I use to hold some info and
indicate what's going on by its presence
Inventory Log form - list of items in inventory, it's where the button is
that does a 'global' locations update, which is what is failing, ultimately.
Alloc WO Subform - a list of active work orders with quantities involved
Part Tiers - tells about the values of an item's stock on hand (may
ultimately be replaced by the stock locations stuff if I can get that to work
reliably)
This is the code behind the button on the form. The subsequent Functions
reside in a module that I can call from anywhere. The StockLocIn function
has been in service for a few months.
Private Sub GlobalLocButton_Click() 'added 8/13/08, kah - adapted from
global WIP routine
On Error GoTo GlobalLocError
Dim ItemCount As Integer
Dim AlloCount As Integer
Dim WipCount As Currency
Dim stPTier, stAlloc As String
Dim stLinkCriteria As String
Dim DoLoc As Integer
Dim VBAns As Variant
Dim SQLStr As String
' VBAns = MsgBox("This will erase Inspection location quantities. Do you
want to continue?", vbYesNo, "Warning - Continue?")
' If VBAns = vbNo Then GoTo GlobalLocExit
[LocAdjInProgress] = True
VBAns = MsgBox("Do you want to start with cleared locations?", vbYesNo,
"Warning - Clear locations?")
If VBAns = vbNo Then GoTo skiplocclear
'clear all bin quantities
SQLStr = "UPDATE [Stock Locations] SET [Stock Locations].BQty = 0,
[Stock Locations].BinCost = 0, [Stock Locations].BinShort = 0;"
DoCmd.SetWarnings False
DoCmd.RunSQL SQLStr
DoCmd.SetWarnings True
'WHILE I'M HERE - DELETE ALL WO* LOCATIONS SINCE WILL BE RECREATED
'clear all bin quantities
' SQLStr = "DELETE ...;"
' DoCmd.SetWarnings False
' DoCmd.RunSQL SQLStr
' DoCmd.SetWarnings True
skiplocclear:
stAlloc = "Allocation WO Subform"
stPTier = "Part Tiers"
'-- Count Inventory Line Items --
DoCmd.GoToRecord , , acLast
ItemCount = Me.CurrentRecord
DoCmd.GoToRecord , , acFirst
DoCmd.GoToControl "WIP"
'-- Loops the Inventory Items --
LoopThis:
If [Stocked] = True Then GoTo WipThis
GoTo NextItem
'-- Update PN Qty --
WipThis:
stLinkCriteria = "[Part #]=" & "'" & Me![Part #] & "'"
'put all tiers of item stock into single Protonex location
DoCmd.OpenForm stPTier, , , stLinkCriteria, acFormReadOnly, acHidden
'debug.print forms![part tiers].[qtyT2]
DoLoc = StockLocIN(Me![Part #], Forms![part tiers].[QtyT2], "Protonex",
Forms![part tiers].[CostA])
DoCmd.Close acForm, stPTier
'-- Open Allocation Form --
stLinkCriteria = "[Part]=" & "'" & Me![Part #] & "'"
DoCmd.OpenForm stAlloc, , , stLinkCriteria
'-- Count Allocation Line Items for Given Part--
DoCmd.GoToRecord , , acLast
AlloCount = Forms![Allocation WO Subform].CurrentRecord
DoCmd.GoToRecord , , acFirst
'--Initialize Wip Counter--
WipCount = 0
'-- Calculate Total WIP for given part --
LoopAllo:
If IsNull(Forms![Allocation WO Subform].[WIPQty]) = True Then GoTo
NextAllo
'Debug.Print "CurRec: " & Forms![Allocation WO Subform].CurrentRecord
WipCount = WipCount + Forms![Allocation WO Subform].[WIPQty]
'Debug.Print "AllocWIPQty:" & Forms![Allocation WO Subform].[WIPQty] & "* *"
& MvQtyHold
If Forms![Allocation WO Subform].[WIPQty] > 0 Then _
DoLoc = StockLocMove(Me![Part #], Forms![Allocation WO
Subform].[WIPQty], "Default", "WO" & Str(Forms![Allocation WO
Subform].[W-Order]))
'End If
NextAllo:
If Forms![Allocation WO Subform].CurrentRecord < AlloCount Then Else
GoTo AdjustWIP
DoCmd.GoToRecord acDataForm, stAlloc, acNext
GoTo LoopAllo
AdjustWIP:
Forms![inventory log form].[WIP] = WipCount
If [WIP] < 0.0001 Then [WIP] = 0
GoTo NextItem
NextItem:
DoCmd.OpenForm "Inventory Log Form"
If Me.CurrentRecord < ItemCount Then Else GoTo CompleteWIP
DoCmd.GoToRecord , , acNext
GoTo LoopThis
'--------End of Main Routine -------------
'------- Routine Closing Statements ------
CompleteWIP:
DoCmd.Close acForm, "Allocation WO Subform"
MsgBox "WIP & Location Adjustments Complete"
GoTo GlobalLocExit
GlobalLocExit:
Refresh
[LocAdjInProgress] = False
Exit Sub
ExitNow:
[LocAdjInProgress] = False
Exit Sub
GlobalLocError:
DoCmd.SetWarnings True
MsgBox Err.Description
MsgBox "!!!An Error Occurred While Updating Locations!!! - Another
User May Be Editing This Record"
MsgBox "Try Again Later"
Resume ExitNow
End Sub
Function StockLocIN(PartNumber As String, AddQty As Double, LocName As
String, BCost As Currency) As Integer 'Copied and modified from PO receiving
logic, 3/21/08 kah
'Puts a quantity of stock into a given location; creates the location if not
found
'FINISH CODES: 0=Unexpected Failure
' 1=Good/Normal
' 2=Location Created (Still Good)
' 3=Location still not found after creation attempt
On Error GoTo Error_StockLocIN
Dim stDocName As String
Dim stLinkCriteria As String
Dim LocationCount As Integer
Dim Retry As Boolean
' Dim PartRec As DAO.Recordset
' Dim PartSQL As String
Dim PartInsp As Variant
Retry = False
StockLocIN = 1 'good finish...if not reset by something else
'check inspection requirement of the part
' PartSQL = "SELECT [Parts (Query)].* FROM [Parts (Query)] " & _
"WHERE ((([Parts (Query)].[Part #])= '" & PartNumber & "'))"
' Set PartRec = CurrentDb().OpenRecordset(PartSQL)
' If PartRec.Fields("InspectReq").Value = True And LocName = "Default"
Then LocName = "Inspection"
PartInsp = DLookup("[InspectReq]", "Parts (query)", "[Parts
(Query)].[Part #]= '" & PartNumber & "'")
If IsNull(PartInsp) = False Then
If PartInsp = True And LocName = "Default" Then LocName = "Inspection"
End If
Restart:
'-- Open Stock Locations ---
stDocName = "Stock Location List"
stLinkCriteria = "[PartNumber]=" & "'" & PartNumber & "'"
DoCmd.OpenForm stDocName, , , stLinkCriteria
Forms![stock location list].[ActivePart] = PartNumber
'-- Check for Negative Entry --
If AddQty <= 0 Then GoTo Exit_StockLocIN
'-- Verify Any Location(s) Exists --
If IsNull(Forms![stock location list].[PartNumber]) = True Then GoTo
NoLocation
'-- Check Number of Locations ---
DoCmd.GoToRecord acDataForm, stDocName, acLast
LocationCount = Forms![stock location list].CurrentRecord
DoCmd.GoToRecord acDataForm, stDocName, acFirst
'-- Location Validation --
LoopLocations:
If IsNull(LocName) = True Or LocName = "Default" Then GoTo Continue1
If Forms![stock location list].[Location] = LocName Then GoTo SetStock
Else GoTo NextLocation
Continue1:
If Forms![stock location list].[Controlled] = False Then GoTo
NextLocation Else GoTo SetStock
NextLocation:
If Forms![stock location list].CurrentRecord >= LocationCount Then GoTo
LocationNotFound
DoCmd.GoToRecord acDataForm, stDocName, acNext
GoTo LoopLocations
SetStock:
'-- Auto Update Primary Stock Location Qty --
If IsNull(Forms![stock location list].[PartNumber]) = True Then GoTo
Exit_StockLocIN
'update cost average value of stock in bin (adjusts for shortages present)
' Forms![stock location list].[BinCost] = ((Forms![stock location
list].[BinCost] * _
' (Forms![stock location list].[BQty] + Forms![stock location
list].[BinShort])) + (BCost)) / (AddQty + Forms![stock location list].[BQty])
If Forms![stock location list].[BQty] > 0 Then
Forms![stock location list].[BinCost] = ((Forms![stock location
list].[BinCost] * Forms![stock location list].[BQty]) + (AddQty * BCost)) _
/ (AddQty + Forms![stock location list].[BQty])
Else
Forms![stock location list].[BinCost] = BCost
End If
Forms![stock location list].[BQty] = Forms![stock location list].[BQty]
+ AddQty 'Me.Add chgd 4/16/07 kah
'added 8/12/08 kah
If CurrentProject.AllForms("Stock Locations Move form").IsLoaded Then _
If Forms![stock locations move form].[shortby] <> 0 Then
Forms![stock location list].[BinShort] = Forms![stock locations move
form].[shortby]
'-- Foating Point Cleanup --
Forms![stock location list].[BQty] = Round(Forms![stock location
list].[BQty], 4)
Forms![stock location list].[Transaction] = AddQty & " IN" 'chgd from
me.add 4/16/07 kah
Forms![stock location list].[TDate] = Now()
DoCmd.Close acForm, "Stock Location List"
GoTo Exit_StockLocIN
'-- Close Stock Locations Form if no location exists --
NoLocation:
'if first no location, attempt to make and then try again
If Not Retry Then
If MakeLoc(PartNumber, LocName) Then
Retry = True
GoTo Restart
End If
End If
DoCmd.Close acForm, "Stock Location List"
If Retry = True Then StockLocIN = 2 'created a location
Exit_StockLocIN:
Exit Function
LocationNotFound:
If IsNull(LocName) = False Then
'if location not found, first time, attempt to make and then try again
If Not Retry Then
If MakeLoc(PartNumber, LocName) Then
Retry = True
GoTo Restart
End If
End If
MsgBox LocName & " Location Not Found"
StockLocIN = 3
End If
GoTo Exit_StockLocIN
Error_StockLocIN:
StockLocIN = 0 'unexpected error
MsgBox Err.Description
Resume Exit_StockLocIN
End Function
Function MakeLoc(PartNumber As String, LocName As String) As Boolean
'Creates a new location in the Location table for the given part number
On Error GoTo Error_MakeLoc
Dim Controlled As Boolean
Dim SQLStr As String
Dim Order As String
Dim OrderMe As Variant
MakeLoc = False 'presume failure
Controlled = False
Order = "nc"
If LocName = "Default" Or LocName = "Protonex" Then
LocName = "Protonex"
Controlled = True
'check existing max order
OrderMe = DMax("val([order])", "stock locations", "[order]<>'nc' and
[partnumber]= '" & PartNumber & "'")
If IsNull(OrderMe) = True Then Order = "1" Else Order = Str(OrderMe + 1)
End If
SQLStr = "INSERT INTO [Stock Locations] ( Location, BQty, PartNumber,
Controlled, [Order] ) " & _
"SELECT '" & LocName & "' AS Expr1, 0 AS Expr2, '" & PartNumber & "'
AS Expr3, " & Controlled & " AS Expr4, '" & Order & "' AS Expr5;"
DoCmd.SetWarnings False
DoCmd.RunSQL SQLStr
DoCmd.SetWarnings True
MakeLoc = True 'if no errors report it's a successful creation
Exit_MakeLoc:
Exit Function
Error_MakeLoc:
DoCmd.SetWarnings True
MsgBox Err.Description
Resume Exit_MakeLoc
End Function
Function StockLocOUT(PartNumber As String, ReqQtyOut As Double, LocName As
String) As Integer 'adapt from WO Pick 'OUT' logic,kah
'Takes a quantity of stock out of a given location; errors and leaves for
manual update if location not found or quantity is insufficient.
'FINISH CODES: 0=Unexpected Failure
' 1=Good/Normal
' 2=
' 3=No Locations Available
' 4=Insufficient Stock
' future: 5=Deviation Qty Used (Still Good)
On Error GoTo Error_StockLocOUT
Dim stDocName As String
Dim stLinkCriteria As String
Dim LocationCount As Integer
Dim PartsValue As Currency '8/12/08 kah
Dim OutQty As Double '8/13/08 kah
StockLocOUT = 1 'good finish...if not reset by something else
PartsValue = 0 '8/12/08 kah
OutQty = ReqQtyOut '8/12/08 kah
'-- Open Locations Form --
stDocName = "Stock Location List"
stLinkCriteria = "[PartNumber]=" & "'" & PartNumber & "'"
If LocName <> "Default" Then
stLinkCriteria = stLinkCriteria & " and [Location]='" & LocName &
"'" 'just specific location
Else
stLinkCriteria = stLinkCriteria & " and [Controlled]=True"
'all controlled locations
End If
DoCmd.OpenForm stDocName, , , stLinkCriteria
Forms![stock location list].[ActivePart] = PartNumber
'-- Set Sort Order --
Forms![stock location list].OrderBy = "Order"
Forms![stock location list].OrderByOn = True
'-- Check Number of Locations ---
DoCmd.GoToRecord acDataForm, stDocName, acLast
LocationCount = Forms![stock location list].CurrentRecord
DoCmd.GoToRecord acDataForm, stDocName, acFirst
If LocationCount <= 0 Then GoTo NoLocation
'-- Location Validation --
LoopLocations:
If LocName = "Default" Then GoTo Continue1
If Forms![stock location list].[Location] = LocName Then GoTo Continue2
Else GoTo NextLocation
Continue1:
If Forms![stock location list].[Controlled] = False Then GoTo NextLocation
Continue2:
If Forms![stock location list].[BQty] >= OutQty Then GoTo SetMoveQty
'allows for fractional less-than-one quantites to function
If Forms![stock location list].[BQty] < 1 Then GoTo NextLocation
If IsNull(Forms![stock location list].[BQty]) = True Then GoTo
NextLocation
'-- Adjust Location Qty --
SetMoveQty:
If Forms![stock location list].[BQty] >= OutQty Then Forms![stock
location list].[MoveQty] = OutQty
If Forms![stock location list].[BQty] < OutQty Then Forms![stock
location list].[MoveQty] = Forms![stock location list].[BQty]
AdjustOutQty:
If IsNull(Forms![stock location list].[MoveQty]) = False Then
OutQty = OutQty - Forms![stock location list].[MoveQty]
PartsValue = PartsValue + (Forms![stock location list].[MoveQty] *
Forms![stock location list].[BinCost]) 'added 8/12/08 kah
End If
MoveIt: 'well, 'flushit' actually
Forms![stock location list].[BQty] = Forms![stock location list].[BQty]
- Forms![stock location list].[MoveQty]
'-- Record Transaction and Date --
If Forms![stock location list].[MoveQty] <> 0 Then Forms![stock location
list].[TDate] = Now
If Forms![stock location list].[MoveQty] > 0 Then Forms![stock location
list].[Transaction] = Forms![stock location list].[MoveQty] & " OUT"
If Forms![stock location list].[MoveQty] < 0 Then Forms![stock location
list].[Transaction] = -Forms![stock location list].[MoveQty] & " IN"
NextLocation:
'-- Continue to next location or go to next WO Item --
If OutQty <= 0.0001 Then GoTo Exit_StockLocOUT
Forms![stock location list].[MoveQty] = Null
If Forms![stock location list].CurrentRecord >= LocationCount Then
StockLocOUT = 4 'insufficient stock in location
GoTo StockShort
End If
DoCmd.GoToRecord acDataForm, stDocName, acNext 'move to next location
GoTo LoopLocations
Exit_StockLocOUT:
If StockLocOUT = 1 Then DoCmd.Close acForm, stDocName
If CurrentProject.AllForms("Stock Locations Move form").IsLoaded Then
Forms![stock locations move form].[partscostave] = PartsValue /
ReqQtyOut
DoCmd.Close acForm, stDocName
End If
Exit Function
StockShort:
StockLocOUT = 4 'insufficient stock in location
stDocName = "Stock Location List" 'reopen form to show all locations
stLinkCriteria = "[PartNumber]=" & "'" & PartNumber & "'"
If CurrentProject.AllForms("Stock Locations Move form").IsLoaded Then
'conditional added 8/12/08 kah
'skip message display if doing a global location adjustement of all
PNs
If CurrentProject.AllForms("Inventory Log form").IsLoaded Then
If Forms![inventory log form].[LocAdjInProgress] = False Then _
MsgBox LocName & " Location has insufficient stock of " &
PartNumber & ". " & OutQty & " are still required. Item will be picked
'short'."
Else
MsgBox LocName & " Location has insufficient stock of " &
PartNumber & ". " & OutQty & " are still required. Item will be picked
'short'."
End If
'goto to specific location, or 1st controlled location, and pick it
short
If LocName <> "Default" Then
stLinkCriteria = stLinkCriteria & " and [Location]='" & LocName
& "'" 'just specific location
Else
stLinkCriteria = stLinkCriteria & " and [Controlled]=True"
'all controlled locations
End If
DoCmd.OpenForm stDocName, , , stLinkCriteria
Forms![stock location list].OrderBy = "Order"
Forms![stock location list].OrderByOn = True
DoCmd.GoToRecord acDataForm, stDocName, acFirst
Forms![stock location list].[MoveQty] = Forms![stock location
list].[MoveQty] + OutQty
Forms![stock location list].[BQty] = Forms![stock location
list].[BQty] - OutQty
PartsValue = PartsValue + (OutQty * Forms![stock location
list].[BinCost])
' Forms![stock location list].[binshort] = OutQty
Forms![stock locations move form].[shortby] = OutQty
Else
DoCmd.OpenForm stDocName, , , stLinkCriteria
If LocName = "Default" Then LocName = "Controlled"
MsgBox LocName & " Location has insufficient stock of " & PartNumber
& ". " & OutQty & " are still required."
End If
GoTo Exit_StockLocOUT
NoLocation:
StockLocOUT = 3 'location not found
MsgBox "location not found"
GoTo Exit_StockLocOUT
Error_StockLocOUT:
StockLocOUT = 0 'unexpected error
MsgBox Err.Description
Resume Exit_StockLocOUT
End Function
Function StockLocMove(PartNumber As String, MoveQty As Double, SourceLoc As
String, DestLoc As String) As Integer '8/12/08 kah
'Moves a quantity of stock out of a given location to another given location;
'FINISH CODES: 0=Unexpected Failure
' 1=Good/Normal
' 2=
' 3=No Locations Available
' 4=Insufficient Stock
' future: 5=Deviation Qty Used (Still Good)
On Error GoTo ErrStockLocMove
Dim stDocName As String
Dim DoLoc As Integer
StockLocMove = 1
stDocName = "Stock Locations Move form"
DoCmd.OpenForm stDocName, acNormal, , , acFormEdit, acHidden
DoLoc = StockLocOUT(PartNumber, MoveQty, SourceLoc)
If DoLoc <> 4 Then Forms![stock locations move form].[shortby] = 0
DoLoc = StockLocIN(PartNumber, MoveQty, DestLoc, Forms![stock locations
move form].[partscostave])
Exit_StockLocMove:
DoCmd.Close acForm, stDocName
Exit Function
ErrStockLocMove:
StockLocMove = 0 'unexpected error
MsgBox Err.Description
Resume Exit_StockLocMove
End Function
