Below I have some code I've written to validate whether the user entered data on a form, which populates a table. I am trying to confirm whether they have left field (MinAge) null. I am getting a data mismatch when I run the code. Is this the best way to do this? Help!
Dim MinAgeVal As Integer
MinAgeVal = DLookup("[MinAge]", "User_ProductDefaultsAge")
If MinAgeVal Is Null Then
x = MsgBox("Missing Minimum Age Value", vbCritical)
Else
x = MsgBox("clear", vbCritical)
End If
Also, the may be multiple rows within the table.
(UPDATED):
Ok... I have a table, which is populated by a user from a form. The user will enter a series of age ranges (min and max)... 0 - 5, 6 - 10, etc... each min / max range will be on its own row... I need to write code that will check each row for three things... 1) that there aren't any fields (min or max) that are null... 2) that the min range is not greater or equal to the max range... the the next row of data is in sequential order (max year of record 1 is less than the min year of record 2)
Min Year Max Year
0 1
2 10
15
Below, some code was provided for guidance...
Dim RS As DAO.Recordset
Dim SQL As String
'ordering is only important if you want the FIRST three MIDs.
'If you don't care, just omit the "order by MID" part.
SQL = "select top 3 MID from DealContent where DealID = xxx order by MID"
Set RS = CurrentDb.OpenRecordset(SQL)
Do While Not RS.EOF
Me!MID = Me!MID & RS("mid") & " "
RS.MoveNext
Loop
RS.Close
Set RS = Nothing
I get what most of the code is doing but can't figure out how to make/alter my code to do:
Set RS = CurrentDb.OpenRecordset(SQL)
Do While Not RS.EOF
Me!MID = Me!MID & RS("mid") & " "
RS.MoveNext
Try this:
Dim MinAgeVal As Variant
MinAgeVal = DLookup("[MinAge]", "User_ProductDefaultsAge")
If IsNull(MinAgeVal) Then
x = MsgBox("Missing Minimum Age Value", vbCritical)
Else
x = MsgBox("clear", vbCritical)
End If
The answer that Gustav provided will only work for one row. Dlookup cannot handle more than one record. You will need to use a recordset. Please see the link
Related
I want to fetch TOP N random records from the table but not more than 2 records for same name.
SELECT TOP 7 Table1.ID, Table1.Name, Table1.Salary, Rnd(Abs([Table1]![id])) AS Expr1
FROM Table1
GROUP BY Table1.ID, Table1.Name, Table1.Salary, Rnd(Abs([Table1]![id]))
ORDER BY Rnd(Abs([Table1]![id]));
It is giving more than two records for same name. Would someone please provide some assistance.
Use this query:
SELECT
ID,
[Name]
FROM
[Table1]
ORDER BY
Rnd(-Timer()*[ID]);
Then open it as a Recordset and traverse it from the start and pick IDs (could be saved in an array) while recording the the Name used (a Collection could be used for this).
If a Name has been used twice, skip the record and move to the next.
When you have picked seven IDs, stop. The array of IDs will identify your seven records.
Save the query as RandomAll. Then use it in this function:
Public Function RandomTwo() As long()
Dim rs As DAO.Recordset
Dim Names As New Collection
Dim Used As Integer
Dim Index As Integer
Dim Ids() As Long
Set rs = CurrentDb.OpenRecordset("RandomAll")
ReDim Ids(0)
Do While Not rs.EOF
Used = 0
' Read used count. Will fail if not used.
On Error Resume Next
Used = Val(Names.Item(rs.Fields(1).Value))
On Error GoTo 0
Debug.Print Used, ;
If Used = 1 Then
' Remove key to be added later with updated use count.
Names.Remove rs.Fields(1).Value
End If
If Used < 2 Then
' Record the use count (as text) of the key.
Names.Add CStr(Used + 1), rs.Fields(1).Value
Debug.Print rs!ID.Value, rs.Fields(1).Value
' Add ID to array.
Ids(UBound(Ids)) = rs!ID.Value
If UBound(Ids) = 6 Then
' Seven IDs found.
Exit Do
Else
' Prepare for next ID.
ReDim Preserve Ids(UBound(Ids) + 1)
End If
End If
rs.MoveNext
Loop
rs.Close
' List the found IDs.
For Index = LBound(Ids) To UBound(Ids)
Debug.Print Index, Ids(Index)
Next
' Return the IDs.
RandomTwo = Ids
End Function
The function will return the array holding the seven IDs.
Taking inspiration from Gustav's answer I have designed a bit of VBA code that will generate a SQL string which when used will give you N amount of random records with a limit of 2 per name.
Const PicksLimit As Long = 7 'How many records do you want to select
Dim rs As DAO.Recordset
'Select randomised table
Set rs = CurrentDb.OpenRecordset("SELECT ID, Name From Table1 ORDER BY Rnd(Abs(ID))")
'Define variables for keeping track of picked IDs
Dim Picks As Long, PickNames As String, PicksSQL As String
Picks = 0
PickNames = ""
PicksSQL = ""
With rs
If Not (.BOF And .EOF) Then 'If table is not empty...
.MoveFirst
'Loop until limit reached or table fully looked through
Do Until Picks = PicksLimit Or .EOF
'If name has been picked less than twice before
If Len(PickNames) - Len(Replace(PickNames, "[" & !Name & "]", "")) < ((Len(!Name) + 2) * 2) Then
Picks = Picks + 1 'Increment counter
PickNames = PickNames & "[" & !Name & "]" 'Add name for later checks
PicksSQL = PicksSQL & "ID = " & !Id & " OR " 'Append SQL string
End If
.MoveNext
Loop
'Add front sql section and remove last OR
PicksSQL = "SELECT * FROM Table1 WHERE " & Left(PicksSQL, Len(PicksSQL) - 4)
Else
'If the table is empty no need for ID checks
PicksSQL = "SELECT * FROM Table1"
End If
End With
rs.Close
Set rs = Nothing
'Print SQL String (This can be changed to set a RecordSource or similar
Debug.Print (PicksSQL)
At the moment the SQL string is just printed to the Immediate window but this can be changed to go wherever you need, like a subform's RecordSource for instance.
The code will need to be run every time you want a new random list but it shouldn't take a huge amount of time so I don't see that being too big an issue.
I've been asked to make a change to a VB6 project. The issue I'm having is that I'm trying to get some data from an Access database and assign the data to some variables.
I've got the code:
Dta_Period.DatabaseName = DB_Accounts_Name$
Dta_Period.RecordSet = "SELECT * FROM [Period]"
Dta_Period.Refresh
The table Period contains 2 fields. sMonth and Period
The sMonth field contains the months January - December. The Period field stores a number 0 to 11, to represent what number has been assigned to which month in the customers financial year. January may be 0, or may be 11, essentially.
I need to know which month goes with which period, which is why I have selected this data from the database. However, I'm stuck with what to do next.
How can I loop over the RecordSet (If this is even possible?) and find out what number has been assigned to each month?
I don't think there is a way I can use a Do Until loop. Is it easier to just use 12 separate queries, and then create an array of strings and an array of integers and then loop over the array of strings until I find the correct month, the use the same index for the array on integers?
EDIT 1
To make things simpler to follow for both myself and anyone attempting to provide an answer, I have modified the code.
Dim rstPeriod As DAO.RecordSet
Dim accDB As DAO.Database
' DB_Session is a Workspace, whilst DB_Accounts_Name$ is the name of the DB I am using
Set accDB = DB_Session.OpenDatabase(DB_Accounts_Name$)
SQL = "SELECT * FROM [Period] ORDER BY [Period]"
Set rstPeriod = accDB.OpenRecordset(SQL, dbOpenDynaset)
If rstPeriod.BOF = False Then
rstPeriod.MoveFirst
End If
Dim strMonth(11) As String
Dim pNumber(11) As Integer
Pseudocode idea:
Do Until rstPeriod.EOF
Select Case currentRow.Field("Month")
Case "January"
strMonth(0) = "January"
pNumber(0) = currentRow.Field("Number")
Case "February"
strMonth(1) = "February"
pNumber(1) = currentRow.Field("Number")
End Select
Loop
Loop through recordset and fill the arrays with the month name and month number.
This assumes the recordset returns no more than 12 records.
Public Sub LoopThroughtRecordset()
On Error GoTo ErrorTrap
Dim rs As DAO.Recordset
Set rs = CurrentDb().OpenRecordset("SELECT * FROM [Period] ORDER BY [Period]", dbOpenSnapShot)
With rs
If .EOF Then GoTo Leave
.MoveLast
.MoveFirst
End With
Dim strMonth(11) As String
Dim pNumber(11) As Integer
Dim idx As Long
For idx = 0 To rs.RecordCount -1
strMonth(idx) = rs![Month]
pNumber(idx) = rs![Number]
rs.MoveNext
Next idx
Leave:
On Error Resume Next
rs.Close
Set rs = Nothing
On Error GoTo 0
Exit Sub
ErrorTrap:
MsgBox Err.Description, vbCritical, CurrentDb.Properties("AppTitle")
Resume Leave
End Sub
'strMonth(0) = January
'strMonth(1) = February
'...
'pNumber(0) = 1
'pNumber(1) = 2
'...
I'm having an issue with a piece of VBA I've written for Access. I have a table with a concatenation field 'Concat' (string field) and field called 'Age' (integer field with numerical values).
There are another 61 fields (named '0','1','2'...'60' respectively) where the code needs to work though: I want the code to loop through and, per record entry - for the VBA to Dlookup using the Concat + age fields to another table (called: tbl_Final_Probabilities) and pull back a probability and populate each of these 61 fields with the correct probability. These fields are set up at a numerical field, data type as Single.
The code pulls the correct probability but when I try to update the record for that field at the code line: "rs.Fields(a) = b" (also highlighted in code), I get the error message: "Run time error '3164': 'Field cannot be updated'".
All help welcome on how I need to correct this please, the code used is below.
Punch and pie.
Code:
Dim rs As DAO.Recordset
Dim a As Integer
Dim b As Single
Dim lookup As String
Set rs = CurrentDb.OpenRecordset("SELECT * FROM tbl_Circuit_plus_prob")
For a = 0 To 60
If Not (rs.EOF And rs.BOF) Then
rs.MoveFirst
Do Until rs.EOF = True
rs.Edit
lookup = rs!Concat & (rs!age + a)
b = DLookup("Prob_Date", "tbl_Final_Probabilities", "Concat2 = '" & lookup & "'")
rs.Fields(a) = b '- CODE BREAKS DOWN HERE
rs.Update
rs.MoveNext
Loop
End If
Next a
rs.Close
Set rs = Nothing
Thanks in advance for any and all help.
You loop is turned inside out:
Dim rs As DAO.Recordset
Dim a As Integer
Dim b As Single
Dim lookup As String
Set rs = CurrentDb.OpenRecordset("SELECT * FROM tbl_Circuit_plus_prob")
If Not (rs.EOF And rs.BOF) Then
rs.MoveFirst
Do Until rs.EOF = True
rs.Edit
For a = 0 To 60
lookup = rs!Concat & (rs!age + a)
b = DLookup("Prob_Date", "tbl_Final_Probabilities", "Concat2 = '" & lookup & "'")
rs.Fields(a).Value = b
Next
rs.Update
rs.MoveNext
Loop
End If
rs.Close
Set rs = Nothing
Your code: rs.Fields(a) = b addresses the field with the index 'a' (which is 0 in the first loop), in your table, this is probably an auto increment field and therefore cannot be updated. If you want to write in the fields with the names '0','1',... use this syntax: rs.Fields(x + a) = b, where x is the number of fields+1 (because your loop starts with 0) in the table existing before your field '0'.
Dim lastcomp As String
Dim qty As Integer
Dim rs As New ADODB.Recordset
rs.Open "select Prem1Item,Prem1Qty from [TU FAR Before VB] order by Prem1Item", accCon
Do While Not rs.EOF
If Not IsNull(rs(0).Value) Then
If rs(0).Value <> "n/a" Then
If rs(0).Value <> "" Then
premlist.AddItem rs(0).Value & Format(rs(1).Value, "00")
End If
End If
End If
rs.MoveNext
Loop
rs.Close
Dim i As Integer
Dim j As Integer
i = 1
For i = 1 To premlist.ListCount
For j = 1 To finallist.ListCount
**If Not finallist(j) = premlist(i) Or finallist(j) = "" Then**
finallist.AddItem premlist(i)
End If
Next j
Next i
AccessConnection ("Close")
End If
I am trying to take the records and pull all of the items in Prem1Item and condense then down to not show duplicates and also get the amount from Prem1Qty and show the total of each item it finds. I was trying to put them in these listboxs and then export them to a table that has 2 columns (Premium and Sum)
I am getting error 13 Type mismatch highlighting the area I have put in Bold ("If Not finalist(j) = premlist(i) Or finalist(j) = "" Then"). My plans were to get that list populated and then fill the table to generate my report with.
A list box object does not allow you to retrieve row values with an index value, like you would for an array, or a VBA Collection, or a recordset Fields collection, and so on.
There is probably a better way to say that, but I don't know how. But attempts such as the following will throw that "Type Mismatch" error ...
Debug.Print Me.finallist(1)
Debug.Print TypeName(Me.finallist(1))
If you want to retrieve the bound column value from each of the list box's rows, use the ItemData property.
Dim i As Long
For i = 0 To (Me.finallist.ListCount - 1)
Debug.Print Me.finallist.ItemData(i)
Next
Debug.Print "done"
I think you should try adding the .value to your comparrison e.g.
finallist(j).value = premlist(i).value
I am trying to have a msgbox popup when clicking on a command button within a form in Access 2003.
The msgbox should be triggered by the current date, when compared to dates referenced within a table that is in the database. It would look like this:
If Date() is < [Date in table?], THEN "Msgbox" = "It is now Quarter 2"
once it is beyond the date for quarter 3, the msg box would read "It is now Quarter 3"
Thanks if you can help
Access has a set of functions called Domain Functions for looking up a single piece of information stored in a table. Some of the most common ones are DCount(), DLookup(), DSum(), DAvg(), DMax(), and DMin().
You need to use the DLookup function for this. Basically, it needs a field name and a table name to lookup a value. And in many cases you want to include a criteria statement (or WHERE clause) as the third argument to make sure that the DLookup function is actually retrieving the value from the correct row. If you don't pass in a criteria statment, the Domain functions will simply return the first match.
If Date() <= DLookup("SomeDateField", "tblYourTableName") Then
MsgBox "The date in stored in the table is today or else is in the future."
Else
MsgBox "The date stored in the table is in the past."
End If
Here's an alternate way to write this:
If Date() < DLookup("SomeDateField", "tblYourTableName") Then
MsgBox "The date in stored in the table is in the future."
Else
MsgBox "The date stored in the table is today or is in the past."
End If
And here's how you do it if you have multiple records/rows in the table. You then need to some kind of criteria statement to narrow it down to retrieving the value you want to from the very row you want.
If Date() < DLookup("SomeDateField", "tblYourTableName", "UserID = 1") Then
MsgBox "The date in stored in the table is in the future."
Else
MsgBox "The date stored in the table is today or is in the past."
End If
While it's not really what you are asking, I think it's important to realize what's really going on behind the scenes with this function (and other domain functions). Basically, you are choosing to retrieve one single value from one single table with the option to specify which record/row you want the value retrieved from using a criteria statement, known as a WHERE clause in SQL. So let's take a look at how you would write a function like this, and at how Microsoft likely did write their DLookup function.
Public Function MyLookup(ByVal strField As String, _
ByVal strTable As String, _
Optional ByVal strCriteria As String) As Variant
'Error handling intentionally omitted
'Proper error handling is very critical in
'production code in a function such as this
If strField <> "" And strTable <> "" Then
Dim sSQL as string
sSQL = "SELECT TOP 1 " & strField & " FROM " & strTable
If strCriteria <> "" Then
sSQL = sSQL & " WHERE " & strCriteria
End If
Dim rst As DAO.Recordset
Set rst = CurrentDb.OpenRecordset(sSQL, dbOpenSnapshot)
If Not (rst.EOF and rst.BOF) Then
MyLookup = rst(strField).Value
End If
rst.Close
Set rst = Nothing
End If
End Function
Now let's suppose you want to find the birthdate of someone in your contacts table:
Dim dteBirthDate as Date
dteBirthDate = MyLookup("BirthDate", "tblContacts", "ContactID = " & 12345)
If you didn't have a DLookup function, (or if you didn't write your own), you'd end up writing all that code in the "MyLookup" function up above for every time you needed to lookup a single value in a table.
I think what you're looking for is the following:
'Dates to be retrieved from the db (quarter start dates)
Dim q1 As Date
Dim q2 As Date
Dim q3 As Date
Dim q4 As Date
'Today's date
Dim today As Date
Dim quarter As Integer
Set today = Date()
Set q1 = DLookup("FieldContainingDate", "tableContainingDates", "quarter=1")
Set q2 = DLookup("FieldContainingDate", "tableContainingDates", "quarter=2")
Set q3 = DLookup("FieldContainingDate", "tableContainingDates", "quarter=3")
Set q4 = DLookup("FieldContainingDate", "tableContainingDates", "quarter=4")
Set quarter = 1 'Base case.
If (today > q1) Then quarter = 2
If (today > q2) Then quarter = 3
If (today > q3) Then quarter = 4
MsgBox "It is quarter " & quarter 'Display which quarter it is in a msgbox
You may have to fiddle with the date formatting depending on how you have it stored in the database, etc. It would also be much more efficient to write it in another way (for instance remove the intermediary q# variables) but I wrote it out in a lengthy way to make it more clear.