I have a sub that is supposed to take a number of assignments (this number changes daily) and assign them to 7 associates. There are some conditions to this:
If the # of assignment is less than 7, it assigns all of them to a random associate.
If the # is divisible by 7, it assigns an equal number to each.
If it is not divisible by 7, it assigns equally and then gives the remainder to a random associate.
The problem is the random part. I really don't understand how random works in vba, or at least it seems like it should be super easy, but it's not (maybe). But I have this written and it's not working. (Associates(Int(Rnd() * 7) + 1)). Here is my relevant code:
Earlier in the sub I create an array of the associates and I use some dcounts to get the total assignments for that day:
Dim Associates(6) As Integer
Associates(0) = 4687 'Anita
Associates(1) = 4247 'Alberto
Associates(2) = 2167 'Jeff
Associates(3) = 4334 'Lisa
Associates(4) = 4441 'Carrie
Associates(5) = 2052 'Bobby
Associates(6) = 4657 'Simona
'
Dim Person As Variant
'
TotalPop = DCount("LNo", "qry_PT_Assign")
FractionPop = Int(TotalPop / 7)
LeftPop = TotalPop - (FractionPop * 7)
'
and then I try to actually assign them.
'Assign to Associates
If TotalPop < 7 Then
DoCmd.RunSQL "UPDATE tbl_Assignments SET AudTellerID = " & (Associates(Int(Rnd() * 7) + 1)) & " WHERE AudTellerID IS NULL"
ElseIf LeftPop = 0 Then
For Each Person In Associates
DoCmd.RunSQL "UPDATE tbl_Assignments SET AudTellerID = " & Person & " WHERE LNo IN (SELECT TOP " & FractionPop & " LNo FROM tbl_Assignments WHERE AudTellerID Is Null)"
Next
Else
For Each Person In Associates
DoCmd.RunSQL "UPDATE tbl_Assignments SET AudTellerID = " & Person & " WHERE LNo IN (SELECT TOP " & FractionPop & " LNo FROM tbl_Assignments WHERE AudTellerID Is Null)"
Next
DoCmd.RunSQL "UPDATE tbl_Assignments SET AudTellerID = " & (Associates(Int(Rnd() * 7) + 1)) & " WHERE AudTellerID IS NULL"
End If
As per my comment, try generating the random number first, assign it to a variable, and then pass the variable into Associates().
Dim rndInt as Integer
rndInt = Int(Rnd() * 7) + 1
Associates(rndInt)
Then as #Chips said, you can use
Debug.print rndInt
Or
Msgbox rndInt
to check its value
That way you'll be able to see what number is actually being generated
The trick is to use a negative seed that changes constantly.
So add a time dependant seed to Rnd which changes for every unique id like in this sample select query:
SELECT
Table1.ID,
Table1.SomeField,
Table1.AnotherField,
Rnd(-Timer()*[ID]) AS RandomIndex
FROM
Table1
ORDER BY
Rnd(-Timer()*[ID]);
In your code, the expression could be something like this:
.. " & (Associates(Int(Rnd(-Timer()*" & [ID] & ") * 7) + 1)) & " ..
Related
I have two txt boxes and two combo boxes on a form. There is also a subform linked to the temptable that I want to have rebuilt/filter each time one of the controls is changed (using after update on each control to trigger the following sub)
I receive Run-time error '91: Object variable or with block variable not set on line Items(i) = Thing
I am not sure using " (i) " works with MS Access 365 or I am dimensioning incorrectly?
Thank you.
Private Sub Lookupstuff()
Dim i As Integer
Dim Items(1 To 4) As Object
sql = "DELETE * FROM tblTemp"
CurrentDb.Execute sql
i = 0
FilterArray = Array(Me.txtNew, Me.cmbS, Me.cmbP, Me.txtSl)
For Each Thing In FilterArray
If Not IsNull(Thing) Then
i = i + 1
Items(i) = Thing <--Error is here. Items(i) is empty.
End If
Next
If i = 0 Then
Forms!frmNew.Requery
Forms!frmNew.Refresh
End If
If i = 1 Then
Filter = Items1
End If
If i = 2 Then
Filter = Items1 & " AND " & Items2
End If
If i = 3 Then
Filter = Items1 & " AND " & Items2 & " AND " & Items3
End If
If i = 4 Then
Filter = Items1 & " AND " & Items2 & " AND " & Items3 & " AND " & Items4
End If
sql = "INSERT INTO tblTemp SELECT * FROM tblQ"
If Not IsNull(Filter) Then
sql = sql & " WHERE " & Filter
End If
CurrentDb.Execute sql
Forms!frmNew.Requery
Forms!frmNew.Refresh
End Sub
Since you are assigning a reference to object in the array, you must use Set, i.e.:
Set Items(i) = Thing
Also, presumably each reference to Items1, Items2 etc. should actually be Items(1), Items(2) in order to access the objects referenced at these indices of the array.
I am fairly new to the world of programming and am self-taught. From everything I've read I think I need code that includes the use of sub-queries. However, I've never created any sub-queries so I'm a little lost on how to accomplish that.
I have a table that include multiple tickets entered by different users for specific teams and categories. I need to count the # of tickets per combinations and then pull back a random no of tickets (5 %) based on each combination.
For example the combo of Smith,SamL&CInquiry has 176 tickets, I need to pull 9 of those tickets
The combo of Brown,TomL&CLicensing has 22 tickets, I need to pull 1 of those.
I am attempting to do this in Access database.
Here's what I've tried:
Public Function Test()
Set dbs = CurrentDb
Dim newqry As QueryDef
Set newqry = dbs.CreateQueryDef(rst2) i = 1 i2 = 1
Set rst = dbs.OpenRecordset("Query1", dbOpenDynaset)
Do Until i2 > i
rst.Move Int(Rnd(rst.RecordCount) * 100)
If i2 = 1 Then
query_filter_store = " where combo ='" & rst.combo.Value & "'"
Else
query_filter_store = query_filter_store & " or " & "combo='" & rst.combo.Value & "'"
End If
i2 = i2 + 1
Loop
'Set rst2 = dbs.OpenRecordset("select * from query1" & query_filter_store)
Set rst2 = dbs.CreateQueryDef("test_query", "select * from query1 " & query_filter_store)
I have an expenditures subform in Access 2010 that lists the predicted costs associated with the project for each year. Most projects only have one year, but some have more than one. Each cost has a Final checkbox next to it that should be checked when the amount is confirmed, ie. at the end of each year.
It basically looks something like this:
Year | Cost | Final
--------+-----------+--------------------
2017 | $100 | [checked box]
2018 | $200 | [unchecked box]
| | [unchecked box]
I have another field outside the table, FinalCost, that adds up everything in the Cost field. Right now, it fills in the amount from any year which has a checked Final box. That should only be filled when all the Final boxes are checked.
Ex. Right now, it should show nothing even though Final for 2017 is checked. When 2018 is checked, it should show $300. Instead, it shows $100 even though there's still an empty checkbox.
This is the code for this form.
Private Sub Form_AfterUpdate()
Dim rs1, rs2 As Recordset
Dim sql, sql2 As String
sql = "SELECT Sum(Amount) as Final From Expenditures " & _
"Where ProjNo = '" + Me.ProjNo + "' And Final = True Group by ProjNo"
sql2 = "SELECT FinalExpenditure From ActivityCash " & _
"Where ProjNo = '" + Me.ProjNo + "'"
Set rs1 = CurrentDb.OpenRecordset(sql, dbOpenDynaset, dpinconsistent)
Set rs2 = CurrentDb.OpenRecordset(sql2, dbOpenDynaset, dpinconsistent)
If rs1.RecordCount > 0 Then
If rs2.RecordCount > 0 Then
Do While Not rs2.EOF
rs2.Edit
rs2!FinalExpenditure = rs1!Final
rs2.Update
rs2.MoveNext
Loop
End If
End If
rs2.Close
rs1.Close
Set rs1 = Nothing
Set rs2 = Nothing
End Sub
What would be the best way to go about doing this?
EDIT: When the last box is checked, a new row is automatically added with an untoggled checkbox but no information.
Replace the statement beginning with sql = ... with this:
sql = "SELECT SUM(e1.Amount) AS Final " & _
" FROM Expenditures AS e1 " & _
" WHERE NOT EXISTS (SELECT 'x' FROM Expenditures e2 WHERE e2.Final=0 AND e1.ProjNo = e2.ProjNo) " & _
" AND e1.ProjNo = '" & Me.ProjNo & "'"
This query will return data only if there are all expeditures for the project marked as final. As you check for rs1.RecordCount > 0 there will be no update if this query returns no records.
So, before sql, I would verify that all records have True in your Final field.
To do that, let's just return a COUNT() of (any) records that have Final = False, and we can then decide to do what we want.
So, something like,
Dim Test as Integer
test = DCount("*", "YourTableName", "Final = False AND ProjNo = " & Me.ProjNo &"")
If test > 0 Then
'Don't fill the box
Else
'Fill the box, everything is True
'Read through your recordsets or whatever else you need to do
End If
To use a query, we essentially need to replicate the Dcount() functionality.
To do this, we need another Recordset variable, and we need to check the value of the Count() field from our query.
Create a query that mimicks this:
SELECT COUNT(*) As CountTest
FROM YourTable
HAVING Final = False
AND ProjNo = whateverprojectnumberyou'reusing
Save it, and remember that query's name.
Much like the DCount(), we need to make this "check" determine the route of your code.
Dim rst As DAO.Recordset
Set rst = CurrentDb.OpenRecordset("YourQuery'sNameHere")
If rst!CountTest > 0 Then
'They are not all Checked (aka True)
Else
'Supply the value to the FinalCost
End If
Set rst = Nothing
Change this:
sql = "SELECT Sum(Amount) as Final From Expenditures " & _
"Where ProjNo = '" + Me.ProjNo + "' And Final = True Group by ProjNo"
For this:
"SELECT SUM(Amount) - SUM(IIF(Final,1,0)*Amount) as YetToConfirm, SUM(Amount) as Confirmed From Expenditures " & _
"Where ProjNo = '" + Me.ProjNo + "' Group by ProjNo"
rs1 will return two values, the total value if all costs were confirmed in the rs1!Confirmed, and the value yet to confirm in rs1!YetToConfirm
Then here:
Do While Not rs2.EOF
rs2.Edit
rs2!FinalExpenditure = rs1!Final
rs2.Update
rs2.MoveNext
Loop
change it to:
Do While Not rs2.EOF
rs2.Edit
rs2!FinalExpenditure = Iif(rs1!YetToConfirm = 0, rs1!Confirmed, 0)
rs2.Update
rs2.MoveNext
Loop
One way to process this would be check using a subquery whether last year(verified using a dmax function) in each project has been checked in the final column, if this is true, get your sum of checked amounts, else dont calculate the sum.
I have modified your sql string to include this and I tested it against your given example to confirm its showing a sum of $300 or nothing.
SQL = ""
SQL = SQL & " SELECT Sum(Amount) as Final From Expenditures "
SQL = SQL & " Where ProjNo = '" & Me.ProjNo & "' And Final = True "
SQL = SQL & " And (SELECT Expenditures.Final FROM Expenditures where year = ( "
SQL = SQL & " DMax('Year','Expenditures','ProjNo= " & Chr(34) & Me.ProjNo & Chr(34) & "'))) = true "
SQL = SQL & " Group by ProjNo "
I have an array ListBoxContents(), it will contain the items like '15', '16','25'..upto 10 items. I'm trying to retrieve data in the column Bnumber where data of length >6 and starting with('15', '16','25'...) i.e those items specified in listbox .And trying to query these listbox items in where cluase of the sql statement
Table column Bnumber contains
Bnumber
152
156
1523
16417
AA454
CC654
18A16
1826
18A16
25A76
54A16
54235A68
My VBA code
Private Sub arraywhere()
Dim qry As String
Dim Size As Integer
Size = Form_Input_From.lstdigits.ListCount - 1
ReDim ListBoxContents(0 To Size) As String
ReDim LContents(0 To 30) As String
Dim m As Integer
For m = 0 To Size
ListBoxContents(m) = Form_Input_From.lstdigits.ItemData(m)
Next m
For m = 0 To Size
qry = "SELECT col1,col2,Bnumber " & _
"FROM table WHERE (Len([table].[Bnumber]))>6) AND (Left
([table].[Bnumber],2))=(" & ListBoxContents(m) & ");"
Next m
Debug.Print qry
Application.CurrentDb.QueryDefs("[arrayqry]").sql = qry
DoCmd.OpenQuery "[arrayqry]"
End Sub
But my WHERE clause reads only last array item only. How do i specify array in where clause?
Try something like
" ... ([table].[Bnumber],2)) in ('" & Join(ListBoxContents,"','") & "');"
You are setting qry to a new statement with each iteration of your for loop. Instead you need to concatenate a string based on your list box contents that will look like ("x", "y", "z") and replace = with in.
Finish by setting your query once it will look similar to this:
qry = "SELECT col1,col2,Bnumber " & _
"FROM table WHERE (Len([table].[Bnumber]))>6) AND (Left
([table].[Bnumber],2)) in (" & commaSeperatedContents & ");"
Where commaSeperatedContents is a String that is like ("x", "y", "z") but of course has your values.
Try this one:
Dim inPart As String
For m = 0 To Size
inPart = inPart & "'" & ListBoxContents(m) & "',"
Next m
inPart = Left(inPart, Len(inPart) - 1)
qry = "SELECT col1,col2,Bnumber " & _
"FROM [table] WHERE Len([table].[Bnumber])>6 AND " & _
"Left([table].[Bnumber],2) In (" & inPart & ");"
Debug.Print qry
CurrentDb.QueryDefs("[arrayqry]").SQL = qry
DoCmd.OpenQuery "arrayqry"
The list of items in your array actually seems to be coming from the Form_Import_From_PMT.lstdigits control. Is this control bound to a data source? If so, you can simply join your table to that data source with a join clause that specifies that only rows with Bnumber values starting with the digits in the joined table are to be selected:
select col1, col2, Bnumber
from table as t
inner join tblDigits as d
on left(t.Bnumber, 2) = d.Digits
where len(t.Bnumber) > 6
If the control is not bound to a data source, then bind it now (creating a new table tblDigits to hold the digits, as shown above), and you'll be able to use the above query.
In short, data binding is how you 'use an array in a where clause' in Access.
what I'm trying to do is everytime the program opens the image on a form is different. So I have a simple table with 2 columns ID and ImagePath, how do I create the code so a random record(ImagePath) is chosen, on a form load event or something similar? Rnd is no good, as it will be the same image everytime the database is reopened.
Thanks!
Try calling Randomize once -- before the first time you call Rnd. As, the help topic for Rnd says, "Before calling Rnd, use the Randomize statement without an argument to initialize the random-number generator with a seed based on the system timer."
Rnd is no good?
Option Compare Database
Option Explicit
Sub Test()
Randomize
Dim x As Integer
'Print the first field of a 100 random records
For x = 0 To 100
CallRandomRecord
Next x
End Sub
Sub CallRandomRecord()
Dim rs As DAO.Recordset
Dim recordCount As Long
Dim randomRecord As Long
Set rs = CurrentDb.OpenRecordset("SELECT * FROM MyTable")
rs.MoveLast 'To get the count
rs.MoveFirst
recordCount = rs.recordCount - 1
randomRecord = CLng((recordCount) * Rnd)
rs.Move randomRecord
Debug.Print "Random Record No:" & randomRecord & " Field 1: " & rs.Fields(0)
End Sub
I wrote a couple functions of my own to return a random record and then timed them along with the other solutions offered here. Both of mine beat the Harkins method, but neither of them could touch #ray023's (slightly modified for benchmarking) solution. #ray023's solution is also arguably the simplest. Take that Susan Harkins!
Here's the code. You can copy it and paste into a standard module to test on your data. You just need to change the three constants at the top of the TimeThem module:
Private Declare Function GetTickCount Lib "kernel32" () As Long
Sub TimeThem()
Const Loops As Integer = 10
Const TblName As String = "Batches"
Const FldName As String = "BatchName"
Const IndexFld As String = "BatchID"
Dim i As Integer, s As Long, dummy As Variant
s = GetTickCount
For i = 1 To Loops
dummy = HarkinsRandom(TblName, FldName)
Next i
Debug.Print "Harkins:"; GetTickCount - s
s = GetTickCount
For i = 1 To Loops
dummy = RandomRecord(TblName, FldName)
Next i
Debug.Print "RandomRecord:"; GetTickCount - s
s = GetTickCount
For i = 1 To Loops
dummy = RandomRecordWithIndex(TblName, FldName, IndexFld)
Next i
Debug.Print "WithIndex:"; GetTickCount - s
s = GetTickCount
For i = 1 To Loops
dummy = CallRandomRecord(TblName, FldName)
Next i
Debug.Print "CallRandom:"; GetTickCount - s
End Sub
Function HarkinsRandom(TblName As String, FldName As String)
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset(" SELECT TOP 1 " & FldName & _
" FROM " & TblName & _
" ORDER BY GetRandomValue(" & FldName & ")", _
dbOpenForwardOnly)
HarkinsRandom = rs(0)
End Function
Public Function GetRandomValue(fld As Variant)
Randomize
GetRandomValue = Rnd(1)
End Function
Function RandomRecord(TblName As String, FldName As String)
Dim NumRecs As Long, RecNum As Long
Dim SQL As String, SubSQL As String, rs As DAO.Recordset
Dim IndexFld As String
Randomize
NumRecs = CurrentDb.OpenRecordset("SELECT Count(*) FROM " & TblName, dbOpenForwardOnly)(0)
RecNum = Int(Rnd() * NumRecs + 1)
SQL = " SELECT TOP 1 " & FldName & _
" FROM (" & _
" SELECT TOP " & RecNum & " " & FldName & " " & _
" FROM " & TblName & _
" ORDER BY " & FldName & ")" & _
" ORDER BY " & FldName & " DESC"
Set rs = CurrentDb.OpenRecordset(SQL, dbOpenForwardOnly)
RandomRecord = rs(0)
End Function
Function RandomRecordWithIndex(TblName As String, FldName As String, _
Optional IndexedFieldName As String)
Dim NumRecs As Long, RecNum As Long
Dim SQL As String, SubSQL As String, rs As DAO.Recordset
Dim IndexFld As String
Randomize
NumRecs = CurrentDb.OpenRecordset("SELECT Count(*) FROM " & TblName, dbOpenForwardOnly)(0)
RecNum = Int(Rnd() * NumRecs + 1)
If Len(IndexedFieldName) = 0 Or IndexedFieldName = FldName Then
SQL = " SELECT TOP 1 " & FldName & _
" FROM (" & _
" SELECT TOP " & RecNum & " " & FldName & " " & _
" FROM " & TblName & _
" ORDER BY " & FldName & ")" & _
" ORDER BY " & FldName & " DESC"
Else
SQL = " SELECT TOP 1 " & FldName & _
" FROM (" & _
" SELECT TOP " & RecNum & " " & FldName & ", " & IndexedFieldName & _
" FROM " & TblName & _
" ORDER BY " & IndexedFieldName & ")" & _
" ORDER BY " & IndexedFieldName & " DESC"
End If
Set rs = CurrentDb.OpenRecordset(SQL, dbOpenForwardOnly)
RandomRecordWithIndex = rs(0)
End Function
Function CallRandomRecord(TblName As String, FldName As String)
Dim rs As DAO.Recordset
Dim recordCount As Long
Dim RandomRecord As Long
Set rs = CurrentDb.OpenRecordset("SELECT " & FldName & " FROM " & TblName)
rs.MoveLast 'To get the count
rs.MoveFirst
recordCount = rs.recordCount - 1
RandomRecord = CLng((recordCount) * Rnd)
rs.Move RandomRecord
CallRandomRecord = rs(0)
' Debug.Print "Random Record No:" & randomRecord & " Field 1: " & rs.Fields(0)
End Function
And here are the results of the test running against a table with about 50,000 records (it's a locally linked Jet table; ie, it's in an .mdb on the same computer as where I ran the test):
Harkins: 4461
RandomRecord: 2528
WithIndex: 1918
CallRandom: 172
Harkins: 4150
RandomRecord: 2278
WithIndex: 2043
CallRandom: 47
CallRandom: 63
WithIndex: 2090
RandomRecord: 2324
Harkins: 4197
CallRandom: 46
WithIndex: 1997
RandomRecord: 2169
Harkins: 4150
I ran it four times reversing the order after the first two to account for potential caching advantages. As you can see, my two functions ran about twice as fast as the Harkins solution, but #ray023's solution was at its slowest more than 25 times faster (and at its fastest nearly 100 times faster).
But by all means, benchmark against your own data.
See this article by Susan Harkins on TechRepublic: http://www.techrepublic.com/blog/howdoi/how-do-i-retrieve-a-random-set-of-records-in-microsoft-access/149
I used her GetRandomValue function in this query, which returns a different record each time.
SELECT TOP 1 f.id, GetRandomValue(f.id) AS rnd_value
FROM tblFoo AS f
ORDER BY 2;
The function:
Public Function GetRandomValue(fld As Variant)
Randomize
GetRandomValue = Rnd(1)
End Function
Caution: This approach requires running a function against every row of the table. It may be tolerable for small to medium tables. But you should not use it with very large tables.
I may be too simple to understand the problem, but it seems to me that if you want to retrieve a single random image, then all you need to do is generate a single random number that somehow keys into the table of images available to you. If there are 100 images to choose from, you want a random number from 1 to 100.
So, you generate that number:
Round(100 * Rnd(), 0)
...and then you use that to retrieve the image. If the table of images has an Autonumber PK, you could just use that, and it would be VERY FAST. If your image is in a subform, you could set the LinkMaster to the literal PK value and that would retrieve the image for you.
On the subject of Randomize(), I can't seem to get it to repeat when I call Rnd() in the Immediate window, so I'm not sure if it's needed.
But it all seems like a very simple operation to me, one that may not require any SQL or the use of a recordset. If you go the recordset route, I'd recommend opening it once and persisting it and then navigating it each time you need it, rather than opening it repeatedly each time you need a new image. But if I were doing this, I'd make things as simple for myself as possible and go the Autonumber PK route for the images. If you wanted to do it in SQL, that would be:
SELECT Images.ID, Images.Path
FROM Images
WHERE Images.ID = Round(100 * Rnd(), 0)
Obvoiusly, you'd change 100 to an appropriate number. If you need Randomize(), then replace the direct Round(100 * Rnd(), 0) with a function that calls Randomize() and then returns Round(100 * Rnd(), 0).
But maybe I'm missing some important details that makes this much more complicated than I seem to think it is.