Setting Max ID criteria in Ms Access SQL - sql

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 & "')"

Related

VBA RecordSet function takes too much time to update record using RecordCount

I have one table and one query. Both have the same data field but table COLUMN names are equal to query's ROW name. I update table from query's row data using the following code successfully but it takes too much time to update as there are more than 50 columns name in the table for each employee-
Set rst1 = CurrentDb.OpenRecordset("SELECT * FROM tblPayRollDataTEMP")
Set rst2 = CurrentDb.OpenRecordset("SELECT * FROM qryEmpVerifySalary ")
Do Until rst1.EOF
rst2.MoveFirst
Do Until rst2.EOF
For l = 0 To rst1.Fields.count - 1
If rst1!EmpID = rst2!EmpID And rst1.Fields(l).Name = rst2!Head And rst1!PayBillID = TempVars!BillID Then
With rst1
rst1.Edit
rst1.Fields(l).Value = rst2!Amount
rst1!totDeductions = DSum("Amount", "qryEmpVerifySalary", "[PayHeadType] = 'Deductions' AND [EmpID] = " & rst2!EmpID & "") + DLookup("NPS", "qryEmpPayEarning", "[EmpID] = " & rst2!EmpID & "")
rst1!totRecoveries = DSum("Amount", "qryEmpVerifySalary", "[PayHeadType] = 'Recoveries' AND [EmpID] = " & rst2!EmpID & "")
rst1!NetPayable = rst1!totEarnings - (Nz(rst1!totDeductions, 0) + Nz(rst1!totRecoveries, 0))
rst1.Update
End With
End If
Next
rst2.MoveNext
Loop
rst1.MoveNext
Loop
Set rst1 = Nothing
Set rst2 = Nothing
How to improve the performance of the code?
You should use a query to update your records. This would be the fastest solution. Normally one would match the EmpID and drag and drop the fields into the update query or use an expression. If you have to group before or other complex stuff split it in more querys (two or three). It doesnt matter thou, because in the end you just execute one update query.
For your code, you can replace the domainaggregate functions. DLookup(), DSum(), etc... these are worst for performance. A simple select statement runs way faster than DLookup(). Here are a few replacements:
Function DCount(Expression As String, Domain As String, Optional Criteria) As Variant
Dim strSQL As String
strSQL = "SELECT COUNT(" & Expression & ") FROM " & Domain
'Other Replacements:
'DLookup: strSQL = "SELECT " & Expression & " FROM " & Domain
'DMax: strSQL = "SELECT MAX(" & Expression & ") FROM " & Domain
'DMin: strSQL = "SELECT SUM(" & Expression & ") FROM " & Domain
'DFirst: strSQL = "SELECT FIRST(" & Expression & ") FROM " & Domain
'DLast: strSQL = "SELECT LAST(" & Expression & ") FROM " & Domain
'DSum: strSQL = "SELECT SUM(" & Expression & ") FROM " & Domain
'DAvg: strSQL = "SELECT AVG(" & Expression & ") FROM " & Domain
If Not IsMissing(Criteria) Then strSQL = strSQL & " WHERE " & Criteria
DCount = DBEngine(0)(0).OpenRecordset(strSQL, dbOpenForwardOnly)(0)
End Function

Error trying to pull the first field value from each row

AMTSelect is a declared variable variant type for the Getrows array
rCount is an integer
I'm trying to pull the first field value from each row but I keep getting an error saying that the subscript is out of range. The error happens in the for loop.
Code is below:
If Contractnum <> "" Then
CNTRecords = "Select Count(*) from [Manual_AINs] WHERE [Manual_AINs].[Contract_Number]= '" & Contractnum & "';"
Set rs = CurrentDb.OpenRecordset(CNTRecords)
rCount = rs.Fields(0)
Set rs = Nothing
If rCount > 1 Then
qAMT = "Select [Dollar Amount] from [Manual_AINs] WHERE ((([Manual_AINs].[Contract_Number])='" & Contractnum & "'));"
Set rs = CurrentDb.OpenRecordset(qAMT)
AMTSelect = rs.GetRows
AMTSelectString = "Choose appropriate dollar amount of AIN from the selection below:" & Chr(10) & Chr(10)
For i = 1 To rCount
AMTSelectString = AMTSelectString & i & ".) " & Format(AMTSelect(0, (i - 1)), "$#,##0.00") & Chr(10)
Next i
You aren't requesting any rows with .GetRows - this is basically just calling .GetRows(0), which won't return any rows into your Recordset.
Change this line...
AMTSelect = rs.GetRows
...to:
AMTSelect = rs.GetRows(rCount)
That said, since you are apparently trying to use every line in the Recordset, this is much simpler:
If Contractnum <> "" Then
qAMT = "Select [Dollar_Amount] from [Manual_AINs] WHERE [Manual_AINs].[Contract_Number]='" & Contractnum & "';"
With CurrentDb.OpenRecordset(qAMT)
If Not .EOF Then .MoveFirst
AMTSelectString = "Choose appropriate dollar amount of AIN from the selection below:" & Chr(10) & Chr(10)
Dim i As Long
Do While Not .EOF
i = i + 1
AMTSelectString = AMTSelectString & i & ".) " & Format$(.Fields(0), "$#,##0.00") & Chr(10)
.MoveNext
Loop
End With
End If

Given the VB.net code, combine multiple queries into 1

Given this code below which returns a first recordset (rs) based on a date range with some values that are then used in the second recordset (rs2) to sum up a cost. Further explanation is below the code:
strSQL = "SELECT job, suffix, isnull(qty_scrapped,0),isnull(qty_released,0), isnull(price,0),co_num FROM vwDashboardsQuality "
strSQL &= " WHERE trans_date >= '" & dtpStartDate.Value & "' AND trans_date <= '" & dtpEndDate.Value & "' "
rs = conn.Execute(strSQL)
While Not rs.EOF
strCONUM = Trim("" & rs("co_num").Value)
strSelectString = "SELECT ISNULL(a_cost,0) FROM jobmatl WHERE job='" & rs("job").Value & "' AND suffix = " & Format(rs("suffix").Value)
rs2 = conn.Execute(strSelectString)
While Not rs2.EOF
dblSumActualMaterialCost = dblSumActualMaterialCost + CDbl(rs2(0).Value)
rs2.MoveNext()
End While
rs2.Close()
rs2 = Nothing
rs.MoveNext()
End While
rs.Close()
rs = Nothing
I want to combine the queries into a single query so I am not hitting the database through the second recordset (rs2) just to sum up something that I know can be done in a single query.
Any tips would be helpful. Thank you in advance.
It looks like you're just needing to do an inner join on the two queries to get one result set.
See if this works. If so, you can eliminate the second query and second inner loop.
strSQL = "SELECT d.job, d.suffix, isnull(d.qty_scrapped,0), isnull(d.qty_released,0)," _
& " isnull(d.price,0), d.co_num, ISNULL(m.a_cost,0)" _
& " FROM vwDashboardsQuality d" _
& " INNER JOIN jobmatl m" _
& " ON d.job = m.job" _
& " AND d.suffix = m.suffix" _
& " WHERE trans_date >= '" & dtpStartDate.Value & "'" _
& " AND trans_date <= '" & dtpEndDate.Value & "'"
You can paste this in Management Studio, replacing dates as applicable to check the results.
SELECT d.job, d.suffix, isnull(d.qty_scrapped,0), isnull(d.qty_released,0), isnull(d.price,0), d.co_num,
ISNULL(m.a_cost,0)
FROM vwDashboardsQuality d
INNER JOIN jobmatl m
ON d.job = m.job
AND d.suffix = m.suffix
WHERE trans_date >= '2015-09-29'
AND trans_date <= '2015-09-30'
From your code I see that you are at the end just running a SUM on all values for jobmatl.a_cost that fulfill a condition set by the where clause. So why not doing everything on the same query? And you will save yourself all the unnecessary iterations on the result set, you are loosing previous CPU time and resources there.
Also, you are not using all other values on the first query, why getting them on the first place? I removed them from the following query.
SELECT SUM(j.a_cost)
FROM vwDashboardsQuality vDQ
INNER JOIN jobmatl j
ON vDQ.job = j.job
AND vDQ.suffix = j.suffix
WHERE vDQ.trans_date >= #startdate
AND vDQ.trans_date <= #enddate;

Query to check for duplicates

The following was written to inform a user if they are entering duplicate information.
It never detects the duplicate, but all else around it works.
The values from debug (for formats etc.) are
me.lisAppID = 1
me.dtReviewDate = 10/09/2015
me.txtReviewerName = colin
This is the query
Dim tmpRS As DAO.Recordset
Set tmpRS = CurrentDb.OpenRecordset("SELECT TblReview.ReviewID FROM TblReview Where (TblReview.AppID = " & Me.lisAppID & ") And (TblReview.RevDateTime)= #" & Me.dtReviewDate _
& "# And (TblReview.RevUserID)= '" & Me.txtReviewerName & "'")
If tmpRS.RecordCount > 0 Then
MsgBox "Record is a duplicate, it will not be saved", vbOKOnly
Cancel = 1
Exit Sub
End If
Set tmpRS = Nothing
Here are some things to try.
Explicitly format your date variable when building the sql string:
Set tmpRS = CurrentDb.OpenRecordset("SELECT TblReview.ReviewID FROM TblReview Where (TblReview.AppID = " & Me.lisAppID _
& ") And (TblReview.RevDateTime)= #" & Format(Me.dtReviewDate,"mm/dd/yyyy") _
& "# And (TblReview.RevUserID)= '" & Me.txtReviewerName & "'")
Consider using the optional parameters in the OpenRecordset method. Some types of connection do not actually return a value for the Recordset.RecordCount property. From MSDN:
The RecordCount property doesn't indicate how many records are contained in a dynaset–, snapshot–, or forward–only–type Recordset object until all records have been accessed.

Multiple parameter values in one string in access SQL

I have an array which can have a different amount of values, depending on the situation. I want to put these values as a parameter in a query in ms access.
The problem is, if I use the following code to generate a parameter, it sends the whole string as one value to the query, which obviously does not return any rows.
Do Until i = size + 1
If Not IsEmpty(gvaruocat(i)) Then
If Not IsEmpty(DLookup("uo_cat_id", "tbl_uo_cat", "[uo_cat_id] = " & CInt(gvaruocat(i)))) Then
If IsEmpty(get_uocat_param) Then
get_uocat_param = CInt(gvaruocat(i))
Else
get_uocat_param = get_uocat_param & " OR tbl_uo_step.uo_step_cat = " & CInt(gvaruocat(i))
End If
End If
End If
i = i + 1
Loop
At the moment I have 'Fixed' it by generating an SQL string and leaving the query out all together.
get_uocat = "SELECT tbl_product.prod_descr, tbl_uo_cat.uo_cat_descr, tbl_uo_step.uo_step_descr" & vbCrLf _
& "FROM (tbl_product INNER JOIN tbl_uo_cat ON tbl_product.prod_id = tbl_uo_cat.uo_cat_prod) INNER JOIN tbl_uo_step ON tbl_uo_cat.uo_cat_id = tbl_uo_step.uo_step_cat" & vbCrLf _
& "WHERE (((tbl_uo_step.uo_step_cat) = " & get_uocat_param & ")) " & vbCrLf _
& "ORDER BY tbl_product.prod_descr, tbl_uo_cat.uo_cat_descr, tbl_uo_step.uo_step_descr;"
This is however not very friendly to many changes. So my question is, how do I get the array to send each value as a separate parameter to the query?
Note: IsEmpty() is a custom function which checks for empty variables in case you were wondering.
You can still use a parameterized query in this case, despite your comment to the question. You just need to build the SQL string to include as many parameters as required, something like this:
Dim cdb As DAO.Database, qdf As DAO.QueryDef, rst As DAO.Recordset
Dim sql As String, i As Long
' test data
Dim idArray(1) As Long
idArray(0) = 1
idArray(1) = 3
Set cdb = CurrentDb
sql = "SELECT [LastName] FROM [People] WHERE [ID] IN ("
' add parameters to IN clause
For i = 0 To UBound(idArray)
sql = sql & "[param" & i & "],"
Next
sql = Left(sql, Len(sql) - 1) ' trim trailing comma
sql = sql & ")"
Debug.Print sql ' verify SQL statement
Set qdf = cdb.CreateQueryDef("", sql)
For i = 0 To UBound(idArray)
qdf.Parameters("param" & i).Value = idArray(i)
Next
Set rst = qdf.OpenRecordset(dbOpenSnapshot)
' check results
Do Until rst.EOF
Debug.Print rst!LastName
rst.MoveNext
Loop
rst.Close
Set rst = Nothing
Set qdf = Nothing
Set cdb = Nothing
When I run this on my test database I get
SELECT [LastName] FROM [People] WHERE [ID] IN ([param0],[param1])
Thompson
Simpson
you could make use of the IN Clause, instead. Which would work out better.
Do Until i = size + 1
If Not IsEmpty(gvaruocat(i)) Then
If Not IsEmpty(DLookup("uo_cat_id", "tbl_uo_cat", "[uo_cat_id] = " & CInt(gvaruocat(i)))) Then
If IsEmpty(get_uocat_param) Then
get_uocat_param = CInt(gvaruocat(i))
Else
get_uocat_param = get_uocat_param & ", " & CInt(gvaruocat(i))
End If
End If
End If
i = i + 1
Loop
Then your Query build could use,
get_uocat = "SELECT tbl_product.prod_descr, tbl_uo_cat.uo_cat_descr, tbl_uo_step.uo_step_descr" & vbCrLf _
& "FROM (tbl_product INNER JOIN tbl_uo_cat ON tbl_product.prod_id = tbl_uo_cat.uo_cat_prod) INNER JOIN tbl_uo_step ON tbl_uo_cat.uo_cat_id = tbl_uo_step.uo_step_cat" & vbCrLf _
& "WHERE ((tbl_uo_step.uo_step_cat IN (" & get_uocat_param & "))) " & vbCrLf _
& "ORDER BY tbl_product.prod_descr, tbl_uo_cat.uo_cat_descr, tbl_uo_step.uo_step_descr;"