Need top3 records in MS Access - vba

I have to create a text box in MS Access where users are able to see the top 3 records of a particular result set. So even if the query results in 5 records I only want it to display the top 3 records as three textboxes (sometimes the result may also be 1,2 or 0 records).
I took the easy way out and created a new subform which was connected to the parent form using master/child field. The textbox was placed in the details part of the subform and as a recordsource of the subfrom used the following query:
Select top 3 tbl1.column1, tbl1.column2
from tbl1
column1 is the control source for the textbox and column2 is the column I have used for master/child link.
Now the catch is that the query works fine when I use it without top 3. But when I use top 3 the textbox suddenly disappears and the subform is completely blank.
I am not able to identify the cause of the error. My guess is that it has something to do with type of the subform. Not sure.
Is there any other way I can have a text box whose number can vary on the basis of the results?(but limiting the resultset to 3)
Appreciate the help.

Textbox are not meant to hold more than 1 value.
You are trying to assign three results of 2 columns to one textbox(No can do).
Use listbox to populate as you are doing, assigning the query you just wrote in the rowsource of the list(no subforms needed). This way users will see the three records.

You could use a textbox in order to accomplish what you are trying to do. But will require some VBA coding to accomplish this.
Public function CombineValuesForTextBox() as string
Dim rst as dao.recordset
Dim strSQL as string
strSQL = "SELECT TOP 3 tbl1.Column1 as field1, tbl1.Column2 as field2 " & _
"FROM tbl1;"
set rst = currentdb.openrecordset(strsql)
if rst.recordcount = 0 then 'Checks if the recordset has records or not
CombineValuesForTextBox = "No records found"
goto EndCode 'Or replace with what actions to take if no records are found
else
rst.movelast 'Forces the recordset to fully load
rst.movefirst
do while not rst.eof
if CombineValuesForTextBox = "" or CombineValuesForTextBox = empty then
CombineValuesForTextBox = rst![field1] & " - " & rst![Field2]
else
CombineValuesForTextBox = CombineValuesForTextBox & vbcrlf & _
rst![field1] & " - " & rst![Field2]
end if
Loop
end if
rst.close
set rst = nothing
EndCode:
if not rst is nothing then
rst.close
set rst = nothing
end if
end function
Then on your form put in the code (be sure the textbox is unbound...)
me.textbox = CombineValuesForTextBox

Related

Can an individual record in a recordset be moved?

I have a table subform containing jobs to be completed. I'm creating an algorithm in VBA to organize the jobs in the most efficient order to be completed.
Is there a way to move an individual record in a recordset or am I stuck with OrderBy?
Edit:
To add some clarity, I want to be able to move a record to any other index in the same table. I intend to run my algorithm which will move the records into the order they are to be completed. Then each records' "Process Date" field is set to keep track of the order.
The short answer is "No", the index of a record in a recordset cannot be directly updated. The order of rows in a recordset can only be changed by either setting a different ORDER BY clause and requerying the database, or by setting the Recordset.Sort property or the Form.OrderBy property (when bound to a form).
Let's assume that there is a updatable recordset field called [JobOrder]. The SQL source query can include a sort order like ... ORDER BY [JobOrder] ASC which first sorts the data when it is retrieved from the database. As a matter of fundamental database concept, it should be assumed that if no ORDER BY clause is specified that the database can return data in a random order. (In practice that is not usually the case. It will be sorted by some indexed primary key by default, but that should not be assumed if the order is important.)
The form's (or subform's) sort order can be set and changed without requerying the data from the database again. That is done by setting the OrderBy property and ensuring that OrderByOn = True. (FYI: Unless you take measures to hide default tool ribbons (i.e. toolbars) and shortcut menus, this sort order can be altered by the user.)
Now your VBA code can use various techniques to set the JobOrder values. You could perhaps use the Me.RecordsetClone method to enumerate and update the values using the recordset object. Using RecordsetClone will avoid certain side effects of updating the bound primary recordset. Lastly, the following assumes that all records already have valid, unique JobOrder values, but it assumes that JobOrder is not required to be unique (since the swap technique temporarily sets two rows to the same value). It's up to you to write your own clever implementation to guarantee that JobOrder values remain valid and unique.
Private Sub MoveCurrentUp()
Dim rs As Recordset2
Dim thisID As Long
Dim thisSort As Long
Dim previousID As Long
Dim previousSort As Long
On Error Resume Next
'* Error handling to avoid cases where recordset is empty
'* and/or the current record is not valid (i.e. new record)
If Not IsNull(Me.ID.Value) Then
thisID = Me.ID.Value
If Err.Number = 0 Then
On Error GoTo Catch
'* Any errors from this point should be
'* handled specifically rather than ignored
Set rs = Me.RecordsetClone
rs.FindFirst "ID=" & thisID
If Not rs.NoMatch Then
thisSort = rs!JobOrder
rs.MovePrevious
If Not rs.BOF Then
previousID = rs!ID
previousSort = rs!JobOrder
rs.Edit
rs!JobOrder = thisSort
rs.Update
rs.MoveNext
rs.Edit
rs!JobOrder = previousSort
rs.Update
Set rs = Nothing
RefreshSort
End If
End If
Set rs = Nothing
Debug.Print Me.Sort
End If
End If
Exit Sub
Catch:
MsgBox "Error updating order." & vbNewLine & vbNewLine & _
" " & Err.Number & ": " & Err.Description, vbOKOnly Or vbExclamation, "Error"
End Sub
Aferward, you would refresh the form's sort order with something like:
Private Sub RefreshSort(Optional restoreCurrentRecord As Boolean = True)
Dim rs As Recordset2
Dim saveID As Long
saveID = Me.ID.Value
Me.OrderBy = "[JobOrder] ASC"
Me.OrderByOn = True
If restoreCurrentRecord Then
Set rs = Me.RecordsetClone
rs.FindFirst "ID=" & saveID
If Not rs.NoMatch Then
Me.Bookmark = rs.Bookmark
End If
Set rs = Nothing
End If
End Sub
Or you could update rows using SQL queries, then call Me.OrderByOn = False then Me.Requery to force the entire recordset to be reloaded in the proper order (assuming the record source has a proper ORDER BY clause). This technique has the benefit of wrapping all the changes in a transaction which can be committed or rolled back altogether, something you can't do with the bound form's recordset objects.

Loop through employee numbers and see if certain date falls within a period

Who can help a beginner out. I've added two screenshots to make my story clearer.
My excel sheet is two tabs. One is 'calculation' and other is 'project'.
What i'd like to know is how to program the following in vba:
In the calculation tab there is a employee number in column E. I have to look if that number also is written in the projects tab. If so i need to know if the date of the calculation tab falls within the start and end date in the projects tab. If so then write the info if that row to the empty columns in the calculation tab.
Another problem arises when an employee works multiple jobs in the projects tab. I guess there needs to be another loop in here:
If the date from calculation tab doesn't fall in the period from start to end in the projects tab, is there another row with the same employee number and maybe it falls within that period.
I hope i made my story clear. I know what the steps should be, just not how to program it. I hope someone is able to help me with this.
Since your screenshots appear to be Excel for Windows consider an SQL solution using Windows' JET/ACE Engine (.dll files) as you simply need to join the two worksheets with a WHERE clause for date filter. In this approach you avoid any need for looping and use of arrays/collections.
To integrate below, add a new worksheet called RESULTS as SQL queries on workbooks are read-only operations and do not update existing data. A LEFT JOIN is used to keep all records in Calculations regardless of matches in Projects but matched data will populate in empty columns. Results should structurally replicate Calculations. Adjust column names in SELECT, ON, and WHERE clauses as required (as I cannot clearly read column names from screenshots). Finally, a very important item: be sure date columns are formatted as Date type.
Dim conn As Object, rst As Object
Dim strConnection As String, strSQL As String
Dim i As Integer
Set conn = CreateObject("ADODB.Connection")
Set rst = CreateObject("ADODB.Recordset")
' OPEN DB CONNECTION
strConnection = "DRIVER={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" _ '
& "DBQ=C:\Path\To\Workbook.xlsx;"
conn.Open strConnection
' OPEN QUERY RECRDSET
strSQL = "SELECT t1.*, t2.[Project] AS [Which Project], t2.[Customer] As [Which Customer]," _
& " t2.[Start], t2.[End planned], t2.[Hours per week]" _
& " FROM [Calculation$A$3:$D$1048576] t1" _
& " LEFT JOIN [Projects$A$3:$J$1048576] t2" _
& " ON t1.EmployeeNum = t2.EmployeeNum" _
& " WHERE t1.[Date] BETWEEN t2.Start AND t2.[End planned];"
rst.Open strSQL, conn
' COLUMNS
For i = 1 To rst.Fields.Count Worksheets("RESULTS").Cells(3, i) =
rst.Fields(i - 1).Name
Next i
' DATA ROWS
Worksheets("RESULTS").Range("A4").CopyFromRecordset rst
rst.Close
conn.Close
Set rst = Nothing
Set conn = Nothing
it would be great to let us know, what you have done so far. I think the easiest way for a beginner is to just use two loops. One for the calculation and one for the projects tab.
Then you can start to develop your functionality. Use a "row counter" for each worksheet and iterate trough the rows. Here is an example pseudo code:
Dim lRowCountCalc as Long
Dim lRowCountPrj as Long
lRowCountCalc = 1
lRowCountPrj = 1
do
do
If Table2.Range("A" & lRowCountPrj).Value = Table1.Range("E" & lRowCountPrj).Value Then
If ... dates are equal
'Do some stuff
End if
End If
lRowCountPrj = lRowCountPrj +1
Loop Until lRowCountPrj = 5000 Or Table2.Range("A" & lRowCountPrj).text = ""
lRowCountCalc = lRowCountCalc +1
Loop Until lRowCountCalc = 5000 Or Table1.Range("A" & lRowCountCalc).text = ""
Just check for each employee number in calculation if there is a the same number in the current row in projects. If so, do your checks and fill in the information you need. If there is more than one project, you will find it also because all rows will be checked.
But be careful. This is very expensive because this code iterates for each row in projects over all rows in calculation. But for the beginning I would do it like this.

Microsoft Access - Add all items from a listbox into a table without having to be selected?

I'm making a data entry form that allows me to add new businesses and details for that business, before importing them into their respective tables. For the most part, I have completed it all.
However, there are some pieces of information that require more than one input. For example - a business could have multiple telephone numbers/documents/staff members etc.
I have set up a text box and an add/remove button which adds/removes the text in the textbox to a listbox. I want to be able to import all of the items in the listbox, without having to select them into a table. Is this possible? Most of the answers that I've found online require you to have the items selected.
An example piece of code that I have on the import button is show below. This code adds the address details of the business to the 'Business Address' table.
'Set Table to 'Business Address' then add the fields to the table
Set RST = CurrentDb.OpenRecordset("Business Address", dbOpenTable)
RST.AddNew
RST![Business Name] = Me.txtBusinessName
RST![Address] = Me.txtAddress1 & ", " & Me.txtAddress2
RST![Town/City] = Me.txtTownCity
RST![Postal Code] = Me.txtPostalCode
RST.Update
RST.Close
I was thinking some sort of for loop to add all items in the listbox to a table?
Logically speaking (This is not a real example of working code, just something I imagine this might look like if possible?):
Set RST = CurrentDb.OpernRecordset("Business Telephone", dbOpenTable)
For each item in TelephoneListBox
Rst.AddNew
Rst![Business Name] = Me.txtBusinessName
Rst![Telephone] = Me.TelephoneListBox.Column(0)
I'm not sure how to go about it and if it can actually be done without the items being selected? Any ideas?
Dim l As Long
For l = 0 To Me.List0.ListCount - 1
' Debug.Print Me.List0.ItemData(l) or me.list0.column(0,l)
Next l
This will loop through the items in the list.
To improve on Nathan_Sav's answer:
Dim i As Long
Set RST = CurrentDb.OpenRecordset("Business Telephone", dbOpenTable)
For i = 0 To Me.TelephoneListBox.ListCount - 1
RST.AddNew
Rst![Business Name] = Me.txtBusinessName
RST![Telephone] = Me.TelephoneListBox.Column(0, i)
RST.Update
Next i
Adds the value of 'txtBusinessName' to the table 'Business Telephone', under the field specified (Business Name), for each item that is in the listbox.
Also adds all items in the listbox (TelephoneListBox) to the same table under the field specified (Telephone).

Determining if Spreadsheet Entries Match Database Column Entries

One aspect of my project involves comparing the part number entered by the operator to a predetermined list of part numbers in a column in a database. Right now, my program is telling me that every part number entered in the spreadsheet (50+) does not match any in the database, which I've verified to be incorrect. I've checked that both the spreadsheet part number and the database part number are of string datatype. I've doublechecked that my looping logic is good, and to me seems like it should work. To the best of my knowledge there are no hidden characters in either the database cells or in the spreadsheet cells. I'm completely stumped at this point as to why my program doesn't detect any matches between the spreadsheet and the database. Below is the Sub containing the code for checking that the part numbers match:
Sub CheckPN()
'Connect to the E2 database
Call SetPNConnection
'Open a recordset
Set PNRecordset = New ADODB.Recordset
PNRecordset.Open "EstimRpt", PNConnection, adOpenKeyset, adLockOptimistic, adCmdTable
PNSQLCmd = "SELECT DISTINCT [PartNo] FROM EstimRpt;"
'Loop through data, comparing part numbers to E2 database part number records
TotalBadPNCount = 0
With PNRecordset
For DataRowCount = 2 To TrackingLastRow
PNCount = 0
Part_Number = Tracking.Sheets("Operator Data").Range("A" & DataRowCount).Value
'MsgBox "The datatype for " & Part_Number & " is " & VarType(Part_Number) & "."
Do Until .EOF
'MsgBox "The datatype for " & .Fields("PartNo").Value & " is " & VarType(.Fields("PartNo").Value) & "."
If Part_Number = .Fields("PartNo").Value Then
'If .Fields("PartNo").Value = Part_Number Then
MsgBox Part_Number & " is a match."
PNCount = PNCount + 1
End If
.MoveNext
Loop
If PNCount < 1 Then
MsgBox "The P/N " & Part_Number & " entered in cell A" & DataRowCount & " is incorrect. Please correctly enter the P/N and re-run the program."
TotalBadPNCount = TotalBadPNCount + 1
End If
Next DataRowCount
If TotalBadPNCount >= 1 Then
Exit Sub
End If
End With
PNRecordset.Close
Set PNRecordset = Nothing
PNConnection.Close
Set PNConnection = Nothing
End Sub
On a side note, I'd like to have the entire program stop executing if a part number doesn't match, not just the immediate sub. Currently, just this sub exits upon no part number matches.
Thanks for the help on both of these issues.
Jordan
I'd suggest not using a loop to compare records from your user-submitted dataset to your permanent table. Instead, load the user-submitted dataset into a temporary table in your DB, and use SQL to compare the 2 tables.
You can try something along these lines:
'Load spreadsheet into temp table
<your code here>
'open recordset in order to compare PartNos
Dim db As Database
Set db = CurrentDb
Dim rs As Recordset
sSQL = "select count(*) as [count] from temp " _
& " where temp.PartNo not in (select distinct EstimRpt.PartNo from EstimRpt)"
Set rs = db.OpenRecordset(sSQL)
ctRecords = rs![Count]
'if records are found in temp table that do not exist
'in the perm table, then end execution of everything.
if ctRecords > 0 then
End
else
'run the rest of your code
<your code here>
end if
'Drop temp table
<your code here>
I found my problem at long last. The comparing records between database and spreadsheet does work now. I had to make the following changes to my code:
Instead of:
Do Until .EOF
I needed:
Do Until .EOF = True
I also needed to add the following just after the For Loop declaration:
.MoveFirst
Now my code loops correctly.

DLookup in Access not running until textBox clicked on in Form

I'm setting 12 TextBox ControlSources in my Form from VBA using the following :
...
Me.Oct.ControlSource = "=DSum('GBPValue', 'MF YTD Actual Income & Adret', 'Month=10 AND Org_Type=[Key]')"
Me.Nov.ControlSource = "=DSum('GBPValue', 'MF YTD Actual Income & Adret', 'Month=11 AND Org_Type=[Key]')"
...
[Key] is the name of a textbox in the form
When the form loads up i get some odd behavior -
all of the summary form text boxes are blank as are all the dlookup text boxes
if i then click on one of the text boxes that has a dlookup control source assigned the summary text boxes for the other columns start to populate with 0's and #Num etc. and the dlookup runs and displays the expected numbers
once i've clicked on all the dlookup fields the summary numbers calc properly.
In the final version of this the query will be re-written after user clicks from the VBA so ... is this a sensible way to get the form to re-query the DB and, if so, how can i make the DLookups run/display automatically so that everything displays immediately on form load?
You are probably looking for Recalc (Me.Recalc). However, I suggest you use a recordset, rather than DlookUp, and the Current event for the form:
Dim rs As DAO.Recordset 'Needs MS DAO 3.x library
Dim db As Database
Dim strSQL As String
Set db = CurrentDb()
'Guessing that key is a form value
'Note that Month is a reserved word
strSQL = "SELECT [Month], Sum(GBPValue) As SumVal " _
& "FROM [MF YTD Actual Income & Adret] " _
& "WHERE Org_Type= " & Me.[Key]
& " GROUP BY [Month]"
Set rs=db.OpenRecordset(strSQL)
'You can probably use a Do While Loop, consider
'naming the controls, eg, Month10
rs.FindFirst "[Month]=10"
Me.Oct = rs!SumVal
'and so on