I need help; I have created a table that stores the premium based on the following criteria:
Table_Policy_Premium
1. Category: A
2. Min Age: 0
3. Max Age: 20
4. Premium: USD1000
The same category may have other ranges of age, min 21 max 64, and premium in the next field.
I have another table namely employee_data, where there is a premium field; I want that to be updated from a TPP table based on the following criteria against each employee.
If Table_Policy_Premium - Category Matches with Category in employee_data, and If the age in employee_data is between 0-20, update the premium field in Employee_Table from Table_Policy_Premium with the appropriate premium.
Simply create public function in module that you will call in query (or on form), that will return premium value for given category and age.
Public Function getPremium(strCat As String, intAge as Integer) As Double
'variables
Dim strQuery As String
Dim rstQuery As dao.Recordset
Dim dbs As dao.Database
'set database
Set dbs = CurrentDb
'prepare query
strQuery = "SELECT Premium " & _
"FROM Table_Policy_Premium " & _
"WHERE Category = '" & strCat & "' AND " & _
"[Min Age] <= " & intAge & " AND " & _
"[Max Age] >= " & intAge & ";"
'open recordset
Set rstQuery = dbs.OpenRecordset(strQuery)
'check if there is a record
If rstQuery.EOF Then
'no record - set premium to 0
getPremium = 0
Else
'record found
getPremium = rstQuery!Premium
End If
Set rstQuery = Nothing
Set dbs = Nothing
End Function
Simply call function by inserting this as field in query: getPremium([category],[age])
Related
I am using vba in MS Access to create Invoices in Quickbooks with QODBC.
This process requires multi line invoice items to be inserted first and saved temp till primary invoice information is inserted. I have several invoices that are in need of being inserted as bulk.
EXAMPLE:
MultiLIne (INVOICE ITEMS) = Item #, OrderID, Item Desc, etc.
**MULTILINE matches PRIMARY invoice based on OrderID
Primary (INVOICE) = OrderID, Name, Address, Billing terms, etc.
**Primary is a single line record per orderID
"QB_AppendInvoice_LoopRef" contains the unique orderid's that need to be processed. I was trying to use this as a recordset to import the multiline items based on the current recordset orderid, however, I am unable to reference the current recordset orderid.
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim iCount As Integer
Set db = CurrentDb()
Set rs = db.OpenRecordset("QB_AppendInvoice_LoopRef") 'open the recordset for use (table, Query, SQL Statement)
With rs
If .RecordCount <> 0 Then 'Ensure that there are actually records to work with
'The next 2 line will determine the number of returned records
rs.MoveLast 'This is required otherwise you may not get the right count
iCount = rs.RecordCount 'Determine the number of returned records
Do While Not .BOF
DoCmd.SetWarnings False
'Append Invoice Line (determine tests ordered)
Dim SQL1 As String
SQL1 = "INSERT INTO InvoiceLine (CustomerRefListID, CustomerRefFullName, ARAccountRefListID, ARAccountRefFullName, InvoiceLineSerialNumber, InvoiceLineLotNumber, TemplateRefListID, IsPending, DueDate, TxnDate, InvoiceLineType, InvoiceLineItemRefListID, InvoiceLineItemRefFullName, InvoiceLineDesc, InvoiceLineRate, InvoiceLineAmount, FQSaveToCache, RefNumber)" & _
"SELECT Customer.ListID, Customer.FullName, '4C0000-1070045186', 'Accounts Receivable', Null, Null, '80000023-1495649075', '0', QB_ORDER_DETAILS.OrderDate, QB_ORDER_DETAILS.OrderDate, 'Item', QB_TestList_TestCodes.ListID, QB_TestList_TestCodes.FullName, QB_TestList_TestCodes.Description, QB_TestList_TestCodes.SalesOrPurchasePrice, QB_TestList_TestCodes.SalesOrPurchasePrice, '1', QB_ORDER_DETAILS.OrderID " & _
"FROM ((Customer INNER JOIN contacts ON Customer.AccountNumber = contacts.Company) INNER JOIN QB_ORDER_DETAILS ON contacts.[Full Member Info] = QB_ORDER_DETAILS.Physician) LEFT JOIN QB_TestList_TestCodes ON QB_ORDER_DETAILS.ProductID = QB_TestList_TestCodes.TestCode " & _
"WHERE QB_ORDER_DETAILS.OrderID = rs.Fields.getvalue('OrderID')"
DoCmd.RunSQL SQL1, False
'Append Invoice to Invoice Line (put the tests ordered on an invoice)
Dim SQL2 As String
SQL2 = "INSERT INTO Invoice (CustomerRefListID, CustomerRefFullName, ARAccountRefListID, ARAccountRefFullName, TemplateRefListID, [Memo], IsPending, IsToBePrinted, CustomFieldOther, ItemSalesTaxRefListID, TxnDate, DueDate, RefNumber)" & _
"SELECT Customer.ListID, Customer.FullName, '4C0000-1070045186', 'Accounts Receivable', '80000023-1495649075', [Patient_Last] & ', ' & [Patient_First] & ' - ' & [Full_Specimen_ID], '0', '0', [Patient_Last] & ', ' & [Patient_First] & ' - ' & [Full_Specimen_ID], Null, [OrderDate], [OrderDate], Orders.OrderID" & _
"FROM Customer INNER JOIN (Orders INNER JOIN contacts ON Orders.Physician = contacts.[Full Member Info]) ON Customer.AccountNumber = contacts.Company" & _
"WHERE Orders.OrderID = rs.Fields.getvalue('OrderID')"
DoCmd.RunSQL SQL2, False
.MovePrevious
Loop
Else
MsgBox "There are no records in the recordset."
End If
MsgBox "SENT TO QB - SUCCESS!!!"
End With
rs.Close 'Close the recordset
Set rs = Nothing 'Clean up
DoCmd.SetWarnings True
End Sub
It's because you are updating a string, VBA can't use variables in string like that, here is the correct way of doiing it:
"WHERE Orders.OrderID = " & rs.Fields("OrderID").Value
And if the value is a string, you have to add quotes:
"WHERE Orders.OrderID = '" & rs.Fields("OrderID").Value & "'"
Using Access 2010 and relatively new to Access in general. For simplicity say I have the following two tables:
Tbl 1: Employee_Info
(Fields: Employee_ID (primary key), Employee_Name, & Employee_Status (active, inactive, termed))
Tbl 2: Monthly_Sales
(Fields: Month/Year, Sales, & Employee_ID (foreign key))
Every month a member of our team has to enter in the monthly sales for all active employees and I would like to design a form where all active employees are displayed as records and the person doing the data entry only needs to enter the month and year and sales. Something similar to this:
Date: User inputs date here once and pre-populates all the records below
Column 1: Employee_ID: All active employee IDs are displayed
Column 2: Sales:These fields are blank and user enters in the monthly sales.
I have looked all over the internet and have been unable to find a solution to this problem. I don't think it is as simple as using an append query but again I am relatively new to access. Thanks in advance for your help.
You can use the following code to add records for a month... just change table / field names to match your DB. Your table design should prevent duplicate Employee_ID and YearMonth combinations. If so, code will ignore errors if someone runs code twice for same month. If not, you need method of insuring no dups are added.
Option Compare Database
Option Explicit
Function Create_New_Rows()
Dim strSQL As String
Dim i As Integer
Dim iAdd As Integer
Dim iDuration As Integer
Dim lCampaignID As Long
Dim dbs As DAO.Database
Dim rsIN As DAO.recordSet
Dim rsOT As DAO.recordSet
Dim DateRange As Date
Dim dStart As Date
Dim dEnd As Date
Dim InDate As String
On Error GoTo Error_Trap
InDate = InputBox("Input the Year and Month to process. i.e. 201610", "Enter YYYYMM", _
Format(YEAR(Date) & month(Date), "000000"))
' Add some validation to insure they enter a proper month and year!!
dStart = Mid(InDate, 5, 2) & "/01/" & left(InDate, 4)
dEnd = DateSerial(YEAR(dStart), month(dStart) + 1, 0)
Set dbs = CurrentDb
strSQL = "SELECT Employee_ID, Employee_Status " & _
"FROM Table1 " & _
"Where Employee_Status = 'active';"
Set rsIN = dbs.OpenRecordset(strSQL)
Set rsOT = dbs.OpenRecordset("Table2")
If rsIN.EOF Then
MsgBox "No Active Employees found!", vbOKOnly + vbCritical, "No Records"
GoTo Exit_Code
Else
rsIN.MoveFirst
End If
Do While Not rsIN.EOF
DateRange = dStart
Do
With rsOT
.AddNew
!Employee_ID = rsIN!Employee_ID
!MonthYear = Format(YEAR(DateRange) & month(DateRange), "000000")
.Update
End With
DateRange = DateAdd("d", 1, DateRange)
If DateRange > dEnd Then
Exit Do
End If
Loop
rsIN.MoveNext
Loop
Exit_Code:
If Not rsIN Is Nothing Then
rsIN.Close
Set rsIN = Nothing
End If
If Not rsOT Is Nothing Then
rsOT.Close
Set rsOT = Nothing
End If
dbs.Close
Set dbs = Nothing
MsgBox "Finished"
Exit Function
Error_Trap:
Debug.Print Err.Number & vbTab & Err.Description & vbCrLf & "In: Create_New_Rows"
' Ignore if duplicate record
If Err.Number = 3022 Then
Resume Next
End If
MsgBox Err.Number & vbTab & Err.Description & vbCrLf & "In: Create_New_Rows"
Resume Exit_Code
Resume
End Function
Let's say I have a single table called "Customers". It contains 2 fields:
Name
Address
I want users to be able to select multiple records by selecting their names. For example something like having a list box containing all the names of the records in the database. I want users to be able to select multiple items like:
Dave Richardson
Bob Smith
Sophie Parker
And then only display records with these names in the report.
You can use the WhereCondition option of the DoCmd.OpenReport Method to filter your report as needed.
Const cstrReport As String = "YourReportNameHere"
Dim custNames As String
Dim lItem As Variant
Dim strWhereCondition As String
With Me.yourListBoxName
For Each lItem In .ItemsSelected
custNames = custNames & ",'" & Replace(.ItemData(lItem), "'", "''") & "'"
Next
End With
If Len(custNames) > 0 Then
custNames = Mid(custNames, 2)
strWhereCondition = "[Name] IN (" & custNames & ")"
End If
DoCmd.OpenReport ReportName:=cstrReport, View:=acViewPreview, _
WhereCondition:=strWhereCondition
Note this approach has features in common with PaulFrancis' answer. In fact, I copied his code and modified it. The key difference is that this approach does not require you to revise a saved query in order to filter the report.
The setup I would I have is, a Form with a SubForm and a ListBox, the Listbox will have the names of all your customers. So the RowSource would be,
SELECT
customerNameFieldName
FROM
yourTableName;
The Multi Select property will be setup to Extended. Then a button will have the following code that will generate the SQL for the SubForm's recordsource.
Private Sub buttonName_Click()
Dim lItem As Varaint, strSQL As String
Dim custNames As String, whereStr As String
Dim dbObj As dao.Database
Dim tmpQryDef As QueryDef
Set dbObj = CurrentDb()
For Each lItem In Me.yourListBoxName.ItemsSelected
custNames = custNames & "'" & Me.yourListBoxName.ItemData(lItem) & "', "
Next
Id Len(custNames) <> 0 Then
custNames = Left(custNames, Len(custNames) - 2)
whereStr = "WHERE customerNameFieldName IN (" & custNames & ")"
End If
strSQL = "SELECT someFields FROM someTable " & whereStr
Set tmpQryDef = dbObj.QueryDefs("Summary 3 Q1")
tmpQryDef.SQL = strSQL
DoCmd.OpenReport "yourReportName", acViewNormal
Set dbObj = Nothing
Set tmpQryDef = Nothing
End Sub
So now the SubForm will have the RecordSource based on all the information you have selected in the ListBox.
VBA noob here (as of this mourning),
In MS Access I wrote a test function to find the value of a record base on some criteria you pass in.
The function seems to work fine except in cases where there is a lookup in the column that I am searching.
Basically it might return "19" and 19 corresponds to some other table value.
It seems that the RowSource of the column is what Im after so I can do a second query to find the true value.
Can someone point me in the right direction on finding the RowSource assuming I know the column name and then utilizing it to find the value Im after?
Edit: It seems that Im not explaining myself clearly, Here is a picture of what I trying to get programatically
Try this -- I think I finally understand why you are looking for the RowSource -- sorry I didn't "get" it at first. The field you're trying to pull is a foreign key into a description table.
This function should work as a general solution for all such fields (assuming the RowSource always has the primary key first, and the description second). If there is no RowSource, it will just pull the value of the field.
It's based on your original code, rather than the changes proposed by #ron, but it should set you in the right direction. You should fix it to make it parameterized, and allow for variant data types, as ron suggests (+1 ron)
As an aside, use the ampersand (&) to join strings together in VBA to avoid things like this: abc = "1" + 1, where abc is now equal to 2 instead of "11" as you would expect if both items were intended to be strings.
Public Function lookUpColumnValue(Database As Database, column As String, table As String, lookUpColumn As String, lookUpValue As String) As String
Dim sql As String
Dim recordSet As DAO.recordSet
Dim result As String
lookUpColumnValue = "" 'Return a blank string if no result
On Error Resume Next
sql = "SELECT [" & table & "].[" & column & "] FROM [" & table & "] WHERE [" & table & "].[" & lookUpColumn & "] = '" & lookUpValue & "'"
Set recordSet = Database.OpenRecordset(sql)
If Not recordSet.EOF Then
Dim td As DAO.TableDef
'this gives your number - say, 19
result = recordSet(column)
Set td = Database.TableDefs(table)
'Get the rowsource
Dim p As DAO.Property
For Each p In td.Fields(column).Properties
If p.Name = "RowSource" Then
RowSource = Replace(td.Fields(column).Properties("RowSource"), ";", "")
Exit For
End If
Next
If Not RowSource = "" Then
Dim rs2 As DAO.recordSet
Dim qd As DAO.QueryDef
Set qd = Database.CreateQueryDef("", RowSource)
Set rs2 = Database.OpenRecordset(RowSource)
If rs2.EOF Then Exit Function
PKField = rs2.Fields(0).Name
rs2.Close
qd.Close
sql = "SELECT * FROM (" & RowSource & ") WHERE [" & PKField & "]=[KeyField?]"
Set qd = Database.CreateQueryDef("", sql)
qd.Parameters("KeyField?").Value = result
Set rs2 = qd.OpenRecordset()
If Not rs2.EOF Then
'NOTE: This assumes your RowSource *always* has ID first, description 2nd. This should usually be the case.
lookUpColumnValue = rs2.Fields(1)
End If
Else
'Return the field value if there is no RowSource
lookUpColumnValue = recordSet.Fields(column)
End If
End If
End Function
If I understand your question correctly, I think using a parameter query will solve your problem. Using parameters is good practice since they will perform implicit data type casts and also prevent injection attacks.
Notice in the following function, I changed the lookupValue to a Variant type, which allows you to pass any type of value to the function.
Public Function lookUpColumnValue( _
database As DAO.database, _
column As String, _
table As String, _
lookUpColumn As String, _
lookUpValue As Variant) As String
Dim sql As String
Dim recordSet As DAO.recordSet
Dim result As String
Dim qd As QueryDef
Set qd = database.CreateQueryDef("")
sql = "SELECT [" + table + "].[" + column + "] FROM [" + table + "] " & _
"WHERE [" + table + "].[" + lookUpColumn + "] = [parm1];"
qd.sql = sql
qd.Parameters![parm1] = lookUpValue
Set recordSet = qd.OpenRecordset()
result = recordSet(column)
EDIT
lookUpColumnValue = DLookup("Space Use Description", "Space Use Codes", result)
End Function
So, we have imported data which we have queried and then created a pivot table off that query. It is essentially a list of files, each having unique ID numbers, and various attributes (file extension, type of document, hash, etc). In any case, this data is based off "hits" on keyword searches from a different program. This means that there might be multiple records for the same Unique ID since there are multiple hits.
The pivot table allows us to illustrate/manipulate via filtering out certain criteria (e.g. we don't want certain file extensions or we don't want records with FIELD X or FIELD Y0. The report is fine, but we want to make a form/query/report/whatever that will pull a "count" (based off unique ID) which ignores duplicates. For example, once all the filters are set in the pivot table, based on the filters/output of the pivot table, we want something like this:
.PDF Files: 200 | total for field x | total field y | etc
.DOCX files: 320 | total for field x | total for field y | etc
Obviously, we want to ignore duplicates of the same Unique ID in the counts.
What is the best way to do this considering we will be manipulating the pivot table dynamically and often? The ideal scenario would to have the pivot table and another object (form/report/etc) open, and as the pivot table is manipulated whatever is displaying counts changes as well.
Here are some very rough notes notes. They are only minimally tested, and using IN would be a disaster with a lot of values, however, it would be easy enough to switch this round and use an excluded list. Perhaps you can get some ideas.
Dim oPTable ''PivotTable
Dim oPM ''PivotMember
Dim oFUpd ''PivotFilterUpdate
Dim oChildren ''ChildMembers
Dim fset ''FieldSet
Dim sWhere As String
Dim sTemp As String
Dim sSQL As String
Dim sDelim As String
Dim aStates As Variant
Dim i As Integer
Dim rs As DAO.Recordset
sDelim = """"
aStates = Array("Cleared", "Checked") ''Possible states
Set oPTable = Forms(0).PivotTable.ActiveView
sWhere = vbNullString
For Each fset In oPTable.FieldSets
sTemp = vbNullString
Set oChildren = oPTable.FieldSets(fset).Member.ChildMembers
For i = 0 To oChildren.Count - 1
Set oPM = oChildren(i)
Set oFUpd = oPM.Field.FieldSet.CreateFilterUpdate
If aStates(oFUpd.StateOf(oPM) - 1) = "Checked" Then
Select Case fset.BoundField.DataType
Case adChar, adLongVarWChar
sTemp = sTemp & "," & sDelim & oPM.Caption & sDelim
Case adInteger
sTemp = sTemp & "," & oPM.Caption
Case adDate
sTemp = sTemp & ",#" & oPM.Caption & "#"
Case Else
'' The above is a very short list.
'' Stop
End Select
End If
Next
If sTemp > vbNullString Then
sWhere = sWhere _
& " AND [" & fset.Name & "] IN ( " & Mid(sTemp, 2) & ")"
End If
Next
sSQL = "SELECT DISTINCT ID FROM [" & oPTable.Control.DataMemberCaption & "] "
sSQL = sSQL & "WHERE 1=1" & sWhere
Set rs = CurrentDb.OpenRecordset(sSQL)
MsgBox "Unique: " & rs.RecordCount
if that helps:
http://lazyvba.blogspot.com/2010/11/improve-your-pivot-table-to-count.html
it will get you the unique count of ID numbers by numbers you want, and you can still manipulate the pivot