efandango said:
I want to use an ID value from a combo box on a subform to update the same ID
value in the form's underlying table.
My main form is: frm_Street_Joiner_Main
My Subform is: frm_Street_Joiner_Sub
My Subform table is: tbl_Street_Joiner
My Mainform is: frm_Street_Joiner_Main
The combo box on my subform is called: StreetName, with a column count of
two but the bound column is the actual street name.
SELECT QRY_Street_Names_Joiner_Master.Street_Names,
QRY_Street_Names_Joiner_Master.StreetNameID FROM
QRY_Street_Names_Joiner_Master ORDER BY
QRY_Street_Names_Joiner_Master.Street_Names,
QRY_Street_Names_Joiner_Master.StreetNameID;
The combo box selects the street name, but I want the StreetNameID to update
to the form's underyling table and also appear in a seperate box named
StreetNameID.
Try and analyse this routine and make it work for your application.
Basically, you open the table by using an sql statement and update the table.
Then you copy the data from the table up to your main form.
Public Function CalculateStockLevel(strmainform, strSubformcontrol)
Set db = DBEngine(0)(0)
'tabActivity
Dim strSQL1 As String
'tabPartsMovements
Dim strSQL2 As String
'tabParts
Dim strSQL3 As String
Dim rs1 As Recordset
Dim rs2 As Recordset
Dim rs3 As Recordset
Dim x As Integer
Dim y As Integer
Dim n1 As String
Dim strTemp As String
strTemp = ""
n1 = Chr(10) & Chr(13)
Dim strSearch As String
Dim ActivityArray() As String
Dim max As Integer
Dim QuantitySumArray() As Double
'tabActivity
strSQL1 = "SELECT * from tabActivity"
'tabPartsMovements
strSQL2 = "select * from tabPartsMovements where tabPartsID = " &
Forms!frmParts!tabPartsID & ";"
'tabParts
strSQL3 = "select * from tabParts where tabPartsID = " &
Forms!frmParts!tabPartsID & ";"
Set rs1 = db.OpenRecordset(strSQL1)
Set rs2 = db.OpenRecordset(strSQL2)
Set rs3 = db.OpenRecordset(strSQL3)
If rs1.RecordCount = 0 Then
MsgBox ("no records in tabActivity")
GoTo err_handler
Else
rs1.MoveLast
'MsgBox (rs1.AbsolutePosition)
End If
rs1.MoveLast
max = rs1.RecordCount
rs1.MoveFirst
ReDim ActivityArray(max, 2)
ReDim QuantitySumArray(max)
strTemp = "tabActivity: " & n1 & n1
For x = 0 To rs1.RecordCount - 1
y = x + 1
ActivityArray(y, 1) = rs1!Text
strTemp = strTemp & "y :" & y & ", " & rs1!tabActivityID & ", " & rs1!Text &
n1
rs1.MoveNext
Next x
''''''''''''MsgBox strTemp
strTemp = ""
If rs2.RecordCount = 0 Then
MsgBox ("no records in tabActivity")
GoTo err_handler
Else
'MsgBox (rs2.RecordCount)
End If
If rs2.RecordCount = 0 Then
GoTo err_handler
Else
rs2.MoveLast
max = rs2.RecordCount
''''''''''''''''''''''''''MsgBox ("rs2 recordcount " & rs2.RecordCount &
", Max: " & max)
rs2.MoveFirst
'strTemp = "tabPartsMovements: " & n1 & n1
For x = 1 To max
'strTemp = strTemp & "Abs.Pos.: " & rs2.AbsolutePosition &
", " & "Act: " & rs2!Activity & ", " & "Qty: " & rs2!Quantity & n1
QuantitySumArray(rs2!tabActivityID) =
QuantitySumArray(rs2!tabActivityID) + rs2!Quantity
rs2.MoveNext
Next x
'''''''''''''''''''''MsgBox (strTemp)
strTemp = "max check" & n1
For x = 1 To max
strTemp = strTemp & Str(x) & n1
Next x
End If
'''''''''''''''''MsgBox strTemp
'create sum on activity id (total on purchase, total on sales etc.)
'Quantity Summary
rs1.MoveLast
max = rs1.RecordCount
rs2.MoveFirst
strTemp = "Quantity Summary" & n1
For x = 1 To max
strTemp = strTemp & "x: " & x & Str(QuantitySumArray(x)) & n1
Next x
'''''''''''''''MsgBox (strTemp)
rs3.edit
rs3!Sales = QuantitySumArray(2)
rs3!Purchases = QuantitySumArray(1)
rs3!DepotIssuance = QuantitySumArray(6)
rs3!DepotReceived = QuantitySumArray(5)
rs3!ReconOut = QuantitySumArray(8)
rs3!ReconIn = QuantitySumArray(7)
rs3!DepotReceived = QuantitySumArray(5)
rs3!WshopOut = QuantitySumArray(4)
rs3!WshopIn = QuantitySumArray(3)
rs3!StockReconciliationOut = QuantitySumArray(15)
rs3!StockReconciliationIn = QuantitySumArray(14)
rs3!OnBoardIssuance = QuantitySumArray(10)
rs3!OnBoardReceived = QuantitySumArray(9)
rs3!CreditNotesPendingOut = QuantitySumArray(12)
rs3!OrdersPendingIn = QuantitySumArray(11)
rs3!StockOnHand = rs3!SubtotalII - rs3!SubtotalI
rs3!SubtotalI = rs3!Sales + rs3!DepotIssuance + rs3!ReconOut + rs3!WshopOut
+ rs3!StockReconciliationOut
rs3!SubtotalII = rs3!Purchases + rs3!DepotReceived + rs3!ReconIn +
rs3!WshopIn + rs3!StockReconciliationIn
rs3!StockOnHand = rs3!SubtotalII - rs3!SubtotalI
rs3!SubtotalIII = rs3!SubtotalI + rs3!StockOnHand
rs3!SubtotalIV = rs3!SubtotalII
rs3!SubtotalVI = rs3!SubtotalIV + rs3!StockOnHand + rs3!OnBoardReceived
rs3!SubtotalV = rs3!SubtotalVI
rs3!StockAvailableI = rs3!StockOnHand + rs3!OnBoardReceived -
rs3!OnBoardIssuance
rs3!SubtotalVIII = rs3!SubtotalVI + rs3!StockAvailableI + rs3!OrdersPendingIn
rs3!SubtotalVII = rs3!SubtotalVIII
rs3!StockAvailableII = rs3!StockAvailableI + rs3!OrdersPendingIn -
rs3!CreditNotesPendingOut
'stock taking
' With rstCustomers
' ' Populate recordset.
' .MoveLast
' ' Find first record satisfying search string. Exit
' ' loop if no such record exists.
' .FindFirst strCountry
' If .NoMatch Then
' MsgBox "No records found with " & _
' strCountry & "."
' Exit Do
'
' strCountry = "Country = '" & strCountry & "'"
'strSearch = "Activity = '" & Str(13) & "'"
strSearch = "tabActivityID = 13"
With rs2
..MoveFirst
..FindLast strSearch
If .NoMatch Then
MsgBox ("no stock take date")
Else
rs3!LastStockTaking = rs2!Date
End If
End With
rs3.Update
Forms(strmainform)(strSubformcontrol).Requery
err_handler:
End Function
