I am trying to create a Work Order System for a company and I am limited to using MS Access. I am wanting to code in a Work Order ID column. This column will be based on 2 combobox options:
BuildingName
TargetDepartment
I need some VBA code to query the WOID column in the table to retrieve the next number. The conditions will be as the below example:
WOID BuildingName TargetDepartment
BUILDA-DEPTA-1 BUILDA DEPTA
BUILDA-DEPTB-1 BUILDA DEPTB
BUILDA-DEPTA-2 BUILDA DEPTA
The VBA code would query the WOID column, and find out if there is a work order for the same building and department and then increment the number at the end by 1. But if there is no WOID that matches the buildingname and targetdepartment, it would create the first entry for that.
So if it finds a matching buildingname and targetdepartment: MaxNumber +1
If it doesn't find a matching buildingname and targetdepartment: 1
Thanks for the help!
You can do this using DLookUp :
where_condition = "[WOID] Like '" & Me.[BuildingNameCombo] & "-" & Me.[TargetDepartmentCombo] & "-*'"
existing_woid = Nz(DLookUp("[WOID]","[TableName]", where_condition),"")
If(existing_woid = "") Then
next_id = 1
Else
next_id = DMax("Mid([WOID], InStrRev([WOID],""-"")+1)","[TableName]", where_condition) + 1
End If
woid = Me.[BuildingNameCombo] & "-" & Me.[TargetDepartmentCombo] & "-" & next_id
You can do it in one line as well, but I think it is better to see the way of thinking behind this.
Edit (with record locking)
Dim s as String, rs as Recordset
s = " Select [WOID] From [TableName] " & _
" Where [WOID] Like '" & Me.[BuildingNameCombo] & "-" & Me.[TargetDepartmentCombo] & "-*'" & _
" Order By 1 Desc"
'This will restrict table access
Set rs = CurrentDb.OpenRecordset(s, dbOpenDynaset, dbDenyRead + dbDenyWrite)
If rs.RecordCount > 0 Then
next_ind = Mid(rs(0), InStrRev(rs(0), "-") + 1) + 1
Else
next_ind = 1
End If
rs.AddNew
rs.Fields("WOID") = Me.[BuildingNameCombo] & "-" & Me.[TargetDepartmentCombo] & "-" & next_ind
rs.Update
rs.Close
Set rs = Nothing
Related
I am trying to find a way to calculate the median of a dataset in access, that is grouped by two columns, typeA, typeB.
This is a sample of the table:
ID (autonumber)
typeA (large number)
typeB (large number)
total (large number)
1
1
1
15
2
2
1
15
3
1
1
45
4
2
1
44
5
1
2
19
6
1
2
4
7
1
2
34
8
2
2
19
9
2
2
18
Using Access 2016
Currently I am using the following code snippet:
Function fMedian(SQLOrTable, GroupFieldName, GroupFieldValue, GroupFieldName2, GroupFieldValue2, MedianFieldName)
DoCmd.SetWarnings False
Dim rs As DAO.Recordset
Set db = CurrentDb
Set rs1 = db.OpenRecordset(SQLOrTable, dbOpenDynaset)
If IsDate(GroupFieldValue) Then
GroupFieldValue = "#" & GroupFieldValue & "#"
ElseIf Not IsNumeric(GroupFieldValue) Then
GroupFieldValue = "'" & Replace(GroupFieldValue, "'", "''") & "'"
End If
If IsDate(GroupFieldValue2) Then
GroupFieldValue2 = "#" & GroupFieldValue2 & "#"
ElseIf Not IsNumeric(GroupFieldValue) Then
GroupFieldValue2 = "'" & Replace(GroupFieldValue2, "'", "''") & "'"
End If
rs1.Filter = GroupFieldName & "=" & GroupFieldValue
rs1.Sort = MedianFieldName
Set rs = rs1.OpenRecordset()
rs.Move (rs.RecordCount / 2)
If rs.RecordCount Mod 2 = 0 Then
varMedian1 = rs.Fields(MedianFieldName)
rs.MoveNext
fMedian = varMedian1 + rs.Fields(MedianFieldName) / 2
Else
fMedian = rs.Fields(MedianFieldName)
End If
End Function
As it stands, this works great for grouping by one column, but I cannot figure out how to allow it to group by on both typeA and typeB. I have by editing the rs1.filter line but to no avail.
Any help with the code, or a better approach would be appreciated.
Thank you!
NOTE: solved using parfaits solution below. added line medianVBA = fmedian before the end of the function.
Consider an extension of #Fionnuala's great answer to calculate median in MS Access by accommodating an open-ended number of grouping variables.
VBA (save below in a standard module of Access project)
Code builds a dynamic SQL string for DAO recordset call for later median calculation. Special handling required for groupings with 0-2 records and null values for groupings.
Public Function MedianVBA(ParamArray Arr() As Variant) As Double
On Error GoTo ErrHandle
Dim N As Long
Dim tblName As String, numCol As String, grpVals As String
Dim strSQL As String
Dim db As DAO.Database, rs As DAO.Recordset
Dim varMedian As Double, fMedian As Double
'BUILD DYNAMIC SQL
tblName = Arr(0)
numCol = Arr(1)
grpVals = " WHERE " & numCol & " IS NOT NULL "
For N = 2 To UBound(Arr) Step 2
If Arr(N + 1) = "" Or IsNull(Arr(N + 1)) Then
grpVals = grpVals & " AND " & Arr(N) & " IS NULL"
ElseIf IsDate(Arr(N + 1)) Then
grpVals = grpVals & " AND " & Arr(N) & " = #" & Arr(N + 1) & "#"
Else
grpVals = grpVals & " AND CStr(" & Arr(N) & ") = '" & Arr(N + 1) & "'"
End If
Next N
strSQL = "SELECT " & numCol _
& " FROM " & tblName _
& grpVals _
& " ORDER BY " & numCol
'CALCULATE MEDIAN
Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
If rs.RecordCount = 0 Then
MedianAcc = fMedian
GoTo ExitHandle
ElseIf rs.RecordCount = 1 Then
MedianAcc = rs.Fields(numCol)
GoTo ExitHandle
End If
rs.Move (rs.RecordCount / 2)
rs.MovePrevious
If rs.RecordCount Mod 2 = 0 Then
varMedian = rs.Fields(numCol)
If rs.RecordCount = 2 Then
rs.MoveLast
Else
rs.MoveNext
End If
fMedian = (varMedian + rs.Fields(numCol)) / 2
Else
fMedian = rs.Fields(numCol)
End If
rs.Close
MedianAcc = fMedian
ExitHandle:
Set rs = Nothing: Set db = Nothing
Exit Function
ErrHandle:
MsgBox Err.Number & ": " & Err.Description, vbCritical, "RUNTIME ERROR"
Resume ExitHandle
End Function
Do note, above VBA function uses a ParamArray where first argument expects the source table and second column expects the numeric column and the remaining is open-ended for group column name and value pairs. Signature of call is as follows:
=MedianAcc("table_name",
"numeric_col",
"group1_column", "group1_value",
"group2_column", "group2_value",
...)
SQL (stored query that calls above VBA function)
Below runs a one-group and two-group median calculation.
SELECT t.typeA, t.typeB
, MedianVBA('[myTable]', '[total]', '[typeA]', t.typeA) AS MedianGrp1,
, MedianVBA('[myTable]', '[total]', '[typeA]', t.typeA, '[typeB]', t.typeB) AS MedianGrp2
FROM myTable t
GROUP BY t.typeA, t.typeB
Excuse me taking a totally different approach here...
Say you have a Table called Table1 with fields Field1.
To find the median of Field1 the SQL query would look like this:
SELECT TOP 1
((SELECT MAX(B.Field1) AS Field1 FROM
(SELECT TOP 50 PERCENT A.Field1 FROM Table1 A)
B) +
(SELECT MIN(D.Field1) AS Field1 FROM
(SELECT TOP 50 PERCENT C.Field1 FROM Table1 C ORDER BY C.Field1 DESC)
D))
/2 AS MEDIAN FROM Table1
(the above split out to make it more readable, I wrote it as only 2 lines)
From there all you have to do is write the vba to make it dynamic - replace 'Table1' with your variable SQLorTable and Field1 with the field to find the median of.
This query does not run at the beginning. Could someone please help look at what is wrong?
If there is any other way to achieve this kindly suggest.
strSQL1 = "SELECT * FROM PharmSales WHERE HospitalNo='" & Me.txtRegNo &
"' And TDate = #" & Format(Me.txtTDate, "M\/dd\/yyyy") &
"# AND SalesItem1 = '" & Me.txtSalesItem1 & "' And
PharmSalesID=
(SELECT MAX(PharmSalesID) FROM PharmSales)"
Set pr = db.OpenRecordset(strSQL1)
With pr
If Not .BOF And Not .EOF Then 'Ensure that the recordset contains records
.MoveLast
.MoveFirst
If .Updatable Then 'To ensure record is not locked by another user
.Edit 'Must start an update with the edit statement
If IsNull(![TotalPaid]) = True And Me.txtGrand_TotalPay.Value >= Me.txtSalesAmt1.Value Then
![DispQty1] = Nz(![DispQty1] + Me.txtSalesQty1.Value, 0)
.Update
ElseIf IsNull(![TotalPaid]) = False And (Me.txtGrand_TotalPay.Value - Me.txtSalesAmt1.Value) >= (txtGrand_TotalFee - Me.txtGrand_TotalPay.Value + Me.txtSalesAmt1.Value) Then
![DispQty1] = Nz(![DispQty1] + Me.txtSalesQty1.Value, 0)
.Update
Else: MsgBox ("Insufficient balance!")
End If
End If
End If
pr.Close
Set pr = Nothing
Set db = Nothing
End With
End Sub
Your SQL checks multiple criteria, but your subquery doesn't have any of these criteria, so it will probably select a record that doesn't conform to your other criteria, causing your recordset to always be empty.
You need to add these criteria to the subquery, not the main query.
Since the subquery will just return one record, you don't have to add them to both.
strSQL1 = "SELECT * FROM PharmSales" & _
" WHERE PharmSalesID=" & _
" (SELECT MAX(PharmSalesID) FROM PharmSales" & _
" WHERE HospitalNo='" & Me.txtRegNo & _
"' And TDate = #" & Format(Me.txtTDate, "M\/dd\/yyyy") & _
"# AND SalesItem1 = '" & Me.txtSalesItem1 & "')"
Good morning,
Here is the situation: Have a column of credit card transactions that lists employee names and charge amounts a.k.a debits. In the same column it also lists employee names with an equal negative amount which shows a credit to the account.
What I am trying to do is to find the employee name and charge amount. Then cycle through the list and find the corresponding negative amount.
For example:
John Doe, $100
Jane Doe, $200
Sam Smith, $300
John Doe, -$100
When you run this module your results should return the names of Jane Doe and Sam Smith because only the records for John Doe had both a positive and negative value.
I have gotten very close to an answer but the solution falls apart when there are duplicate values.
For example:
John Doe, $100
John Doe, $100
John Doe, -$100
In this solution the result should be John Doe, $100
So far I have tried with Access, VBA, and SQL but have not come up with an answer.
For the solution, I don't really care if it means adding another object such as a table or a query to perform the comparison part. In the end I need to see a list of matched and unmatched employee names and values.
Additionally, I thought about adding on a column to my table that has a Boolean logic to show the two "matched" records as this will be a database and we don't necessarily want to delete the matched rows from the table master.
Thanks in advance!
You could add a Boolean field Cleared, and then run a simple loop in VBA to mark those set of record that match as cleared:
Public Function ClearTransactions()
Dim db As DAO.Database
Dim rs1 As DAO.Recordset
Dim rs2 As DAO.Recordset
Dim Criteria As String
Set db = CurrentDb
Set rs1 = db.OpenRecordset("Select * From Transaction Where Value > 0 And Cleared = False Order By Id")
Set rs2 = db.OpenRecordset("Select * From Transaction Where Value < 0 And Cleared = False Order By Id")
While Not rs1.EOF
Criteria = _
"Id > " & rs1!Id.Value & " And " & _
"EmpName = '" & rs1!EmpName.Value & "' And " & _
"Value = " & Str(-rs1!Value.Value) & " And " & _
"Cleared = False"
rs2.FindFirst Criteria
If rs2.NoMatch = False Then
rs1.Edit
rs1!Cleared.Value = True
rs1.Update
rs2.Edit
rs2!Cleared.Value = True
rs2.Update
End If
rs1.MoveNext
Wend
rs2.Close
rs1.Close
Set rs2 = Nothing
Set rs1 = Nothing
Set db = Nothing
End Function
I assume your table has a Primary Key (I'll call it TransactionID and assume it's Long Integer - adjust following code as necessary), in which case I would create a tblMatches with columns DebitID and CreditID to record pairs of entries that tie up. To populate this table:
Dim rsDebits As Recordset
Dim lngCreditID as Long
Set rsDebits = CurrentDb.OpenRecordset ("SELECT * FROM tblTransactions " & _
"WHERE ChargeAmount > 0 And TransactionID Not In " & _
"(SELECT DebitID From tblMatches)")
Do While Not rsDebits.EOF
lngCreditID = Nz(DMin("TransactionID", "tblTransactions", _
"EmpName = '" & rsDebits!EmpName & "' And " _
"ChargeAmount = " & -rsDebits!ChargeAmount & " And " _
"TransactionID Not In (SELECT CreditID From tblMatches)"), 0)
If lngCreditID > 0 Then
CurrentDb.Execute "INSERT INTO tblMatches (DebitID, CreditID) " & _
"VALUES (" & rsDebits!TransactionID & ", " & lngCreditID & ")"
End If
rsDebits.MoveNext
Loop
Set rsDebit = Nothing
You can now write a query joining this tblMatches to tblTransactions (twice, once joined ON tblTransactions.TransactionID = tblMatches.DebitID and the other one ON tblTransactions.TransactionID = tblMatches.CreditID) to show all the various entries that match up. To get a list of unmatched entries you'll need to design a query along the lines of
SELECT * FROM tblTransactions
WHERE TransactionID Not In (Select DebitID From tblMatches)
And TransactionID Not In (Select CreditID From tblMatches)
I am trying to write code that makes a collection of associate IDs (Associates is the name of my collection). There are 10 associates at any given time, but the collection will change based on who did what work this month. So once the collection has been made, I want to loop through it and make an SQL statement for each item. Some thing kind of like this:
For Each Item In Associates
qryTopSQL = "SELECT TOP " & QA# & _
" Date, ID, [L#], Deal, RndNum FROM tbl_Data WHERE Date Between #" & _
StartDate & "# And #" & EndDate & "# AND ID = " & Associates() & _
" ORDER BY RndNum"
Next Item
So I end up with however many SQL strings, but I'm having problems with this:
Am I writing the ID = " & Associates() & " part correctly?
How will it name these different strings so that I may access them later?
Once it makes these, I'd like to do a UNION ALL query for all the SQL strings. How would I do this?
Please help if you can, it's greatly appreciated. I'm new to collections and arrays and I don't understand some of the things I've found online.
EDIT for an update:
I tried this:
j = 1
k = 1
For Each Item In Associates
If j = 1 And k = 1 Then
qryTopString1 = "SELECT * FROM qryTopSQL_" & k
Else
qryTopString2 = " UNION ALL SELECT * FROM qryTopSQL_" & k
End If
j = j + 1
k = k + 1
Next Item
'
Set qryTopUnionqdef = CurrentDb.CreateQueryDef("qryTopSQLUnion", qryTopString1 & qryTopString2)
But the resulting query is a union between the first and last TopSQLs, and none in the middle. Clearly the loop at this point it the problem but I can't figure out what to do thus far.
In Access there are two ways to create query objects: VBA queries (in code) or stored queries (using ribbon, wizard, or navigation bar).
Essentially, you want to do both. So in order to migrate your VBA SQL strings into actual stored query objects, you must use QueryDefs. Below is how to iterate to dynamically create the 10 Associates queries and one union query.
Dim qryTopqdef As QueryDef, qryTopUnionqdef As QueryDef, findqdf As QueryDef
Dim i as Integer, j as Integer
' DELETE QUERIES IF EXIST
For each findqdf in CurrentDb.Querydefs
If Instr(findqdf.Name, "qryTopSQL") > 0 Then
db.QueryDefs.delete(findqdf.Name)
End if
Next findqdf
' INDIVIDUAL 10 QUERIES
i = 1
For Each Item In Associates
qryTopSQL = "SELECT TOP " & QA# & _
" Date, ID, [L#], Deal, RndNum FROM tbl_Data WHERE Date Between #" & _
StartDate & "# And #" & EndDate & "# AND ID = " & Item & _
" ORDER BY RndNum"
' QUERY NAMES ARE SUFFIXED BY THE ITERATOR COUNT
Set qryTopqdef = CurrentDb.CreateQueryDef("qryTopSQL_" & i, qryTopSQL)
i = i + 1
Next Item
' UNION QUERY
j = 1
For Each Item In Associates
If j = 1 Then
qryTopSQL = "SELECT TOP " & QA# & _
" Date, ID, [L#], Deal, RndNum FROM tbl_Data WHERE Date Between #" & _
StartDate & "# And #" & EndDate & "# AND ID = " & Item & _
" ORDER BY RndNum"
Else
' UNIONS ARE SIMPLY STACKS OF SELECT STATEMENTS OF SAME COLUMN NUMBER AND DATA TYPE
' TOGETHER JOINED BY THE UNION OR UNION ALL CLAUSE
qryTopSQL = qryTopSQL & " UNION SELECT TOP " & QA# & _
" Date, ID, [L#], Deal, RndNum FROM tbl_Data WHERE Date Between #" & _
StartDate & "# And #" & EndDate & "# AND ID = " & Item & _
" ORDER BY RndNum"
End if
j = j + 1
Next Item
Set qryTopUnionqdef = CurrentDb.CreateQueryDef("qryTopSQLUnion", qryTopSQL)
' UNINTIALIZE OBJECTS
Set qryTopqdef = nothing
Set qryTopUnionqdef = nothing
Also - see this SO post on collections vs arrays
I am working with manually created empty copy of table Products, which I named Products_Backup. What I want to do is to insert every other row from "Spices" category of products into this empty Products_Backup table, since there would be only 6 rows from total of 12 rows, that are in Products table under "Spices" category. The problem is that I don't know how to do that. I tried to use MOD operator for newly created ProductID, but my mentor told me that it is not a proper solution, since he could easily change this ProductID's value and I would get odd rows instead of even.
Private Sub CommandButton0_Click()
Dim db As Database, rst As Recordset
Dim I As Integer, s, s1 As String
Set db = CurrentDb
s = "SELECT Products.* FROM Products WHERE (((Products.CategoryNumber)=2));" ' This value is for Spices
Set rst = db.OpenRecordset(s)
I = 1
While Not rst.EOF
s1 = "INSERT INTO Products_Backup (ProductName, ProductID, CategoryNumber, OrderedUnits) VALUES ('" & rst!ProductName & "', " & I & " , '" & rst!CategoryNumber & "', '" & rst!OrderedUnits & "');"
MsgBox ("Record inserted")
db.Execute s1
I = I + 1
rst.MoveNext
If I Mod 10 = 0 Then
MsgBox ("Inserted " & I & ".record")
End If
Wend
rst.Close
db.Close
End Sub
So with this I can insert all 12 records into Products_Backup, with MsgBox telling me when 10th record was inserted.
But I still have no idea what to do to insert every other row into Products_Backup to get 6 records.
Dim booEveryOther as Boolean
booEveryOther = False
While Not rst.EOF
If booEveryOther Then
s1 = "INSERT INTO ...
End If
booEveryOther = Not booEveryOther
Just use a Boolean value that is set to Not itself with every new record.
i think this should do it better
While Not rst.EOF
s1 = " INSERT INTO Products_Backup (ProductName, ProductID, CategoryNumber, OrderedUnits) " & _
" VALUES ('" & rst!ProductName & "', " & I & " , '" & rst!CategoryNumber & "', '" & rst!OrderedUnits & "');"
db.Execute s1
If I Mod 10 = 0 Then
MsgBox ("Inserted " & I & ".record")
Else
MsgBox ("Record inserted")
End If
I = I + 1
rst.MoveNext
Wend