I have some knowledge of Access and VBA programming, but I stress some. I haven't really used Access since college.
I have a table called Location with 2 fields: Postcode and a Group Code. This list has 1,693,353 records.
I have another table called Group with 2 fields: Group Name and Group Code.
There are about 300 different Authority Records.
I need to make a table/query for each Group and have the different location postcodes in the tables.
I know that I could go through and make 300 different queries all with the Group code as the criteria and that would match them up, but that means making 300 different queries.
What I would like to know is if there is a way of automating this process. I'm not asking for people to create it for me (unless they want to) but if there are any guides or tutorials that people could recommend for learning Access VBA that would help as well.
This query will contain all your groups (I've named it SQL_Group)
SELECT GroupName, Postcode FROM [Group] INNER JOIN Location ON Group.GroupCode = Location.GroupCode will create your groups.
This code will cycle through each group:
Public Sub FilterQuery()
Dim qdf As DAO.QueryDef
Dim rst As DAO.Recordset
Dim rst_Groups As DAO.Recordset
Dim rst_Filtered As DAO.Recordset
Dim db As DAO.Database
Set db = CurrentDb
Set qdf = db.QueryDefs("SQL_Group")
Set rst = qdf.OpenRecordset
Set rst_Groups = db.OpenRecordset("Group")
With rst_Groups
If Not (.BOF And .EOF) Then
.MoveFirst
Do While Not .EOF
rst.Filter = "GroupName = '" & rst_Groups.Fields("GroupName") & "'"
Set rst_Filtered = rst.OpenRecordset
With rst_Filtered
If Not (.BOF And .EOF) Then
.MoveFirst
Do While Not .EOF
Debug.Print .Fields("GroupName") & " : " & .Fields("PostCode")
.MoveNext
Loop
End If
.Close
End With
.MoveNext
Loop
End If
.Close
End With
Set rst_Filtered = Nothing
Set rst = Nothing
Set rst_Groups = Nothing
End Sub
Related
Good Morning,
I am building a database that will be used for scheduling employee work assignments. Below is the code that I am using to create the actual daily work assignments. The intent is that this will loop through each employee in the company and if they are in a work status it will also read their assigned schedule version. Then if the employee is in a work status the db will list their work assignments for each day.
The issue that I am encountering is that this only reads the first employee in the table and gives every other employee the work assignments that the first employee should have. Again, the intent is that the code will look at each employees, one at a time, and append the correct assignments to tbl_employee_work_assignments based on each employees status and schedule version.
Can someone help me understand how to do this correctly, please?
Many Thanks!!!
Private Sub btn_build_assignment_schedule_Click()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("tbl_employees")
DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE * FROM tbl_employee_work_assignments"
Do While Not rs.EOF
Dim X As String
Dim Y As String
X = employee_schedule_version.Value
Y = employee_status.Value
DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE * FROM tbl_employee_work_assignments"
Select Case True
Case X = 1 And Y = 1
db.Execute "qry_append_schedule_1"
Case X = 2 And Y = 1
db.Execute "qry_append_schedule_2"
Case X = 3 And Y = 1
db.Execute "qry_append_schedule_3"
Case X = 4 And Y = 1
db.Execute "qry_append_schedule_4"
End Select
rs.MoveNext
Loop
rs.Close
End Sub
Based on the very limited information provided and making a few assumptions, I would hazard a guess that your code should be changed to something along the lines of the following:
Private Sub btn_build_assignment_schedule_Click()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("tbl_employees")
DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE FROM tbl_employee_work_assignments"
With rs
Do Until .EOF
If !employee_status = "1" Then
Select Case !employee_schedule_version
Case "1": db.Execute "qry_append_schedule_1"
Case "2": db.Execute "qry_append_schedule_2"
Case "3": db.Execute "qry_append_schedule_3"
Case "4": db.Execute "qry_append_schedule_4"
End Select
End If
.MoveNext
Loop
.Close
End With
End Sub
This assumes that employee_status and employee_schedule_version are string-valued fields in your table tbl_employees.
Without knowing the structure of your table tbl_employees and the SQL behind your queries qry_append_schedule_1, qry_append_schedule_2, etc. it is difficult to advise.
I have been searching for this for weeks and I am wondering if I am barking up the wrong tree or if I am just missing something. I am creating a database in Access.
The structure is as follows:
tblOrderDetails
.ORDERID .DEALER .CREATEDATE
4051 Willow 4/17/18
4052 Oak 4/17/18
tblOrderLines
.ROWID .ORDERID .PRODUCTSKU .ORDERLINENUMBER
1 4051 Desk 1
2 4051 Chair 2
3 4052 Dresser 1
4 4052 Chair 2
Hopefully that all makes sense.
ROWID and ORDERID are auto generated Access numbers. I am using them as the primary key so the tblOrderDetails.ORDERID is 1:n tblOrderLines.ORDERID.
My question is in regards to the Order Line Number. Currently, I am using a query to generate the line number when the labels and the packing slips are printed, but it seems like this is not best practice.
Is there some way that i can use SQL or some access function to create a sequential number that restarts for every new order.
This code will give the next Order Line Number for an Order ID.
I think you'll have to put it as the default value for a form control, or maybe in the after_update event.
I'm not sure - have a play around.
Sub Test()
MsgBox NewOrderLineNumber(4051)
End Sub
Public Function NewOrderLineNumber(OrderID As Long) As Long
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim rst As DAO.Recordset
Set db = CurrentDb
Set qdf = db.CreateQueryDef("", "PARAMETERS Order_Identifier Long; " & _
"SELECT COUNT(OrderID) AS CurrentCount " & _
"FROM tblOrderLines " & _
"WHERE OrderID = Order_Identifier")
With qdf
.Parameters("Order_Identifier") = OrderID
Set rst = .OpenRecordset
End With
With rst
If Not (.BOF And .EOF) Then
NewOrderLineNumber = .Fields("CurrentCount") + 1
End If
End With
End Function
I am combining multiple Excel Worksheets into one SharePoint list so our data is all in one place and modifiable by multiple users at once. The Append query worked without a hitch.
Now I am trying to update one filed in the list with an update query but it keeps locking up MS Access (Not Responding, 100% CPU usage). I have to terminate from the task manager.
I have let it run for as much as 10 minutes. So then I switched to the one time use sub procedure below to update through a recordset. Same issue.
I am able to update the field manually one at a time via the linked list in MS Access. I can update the field via datasheet and dialog in SharePoint.
SharePoint 2010
MS Access 2013
Does anyone have any ideas?
Option Compare Database
Option Explicit
Public Sub UpdateDataPlateDates()
On Error GoTo err_trap
Dim db As DAO.Database: Set db = CurrentDb()
Dim rst As DAO.Recordset
Dim strSQL As String
Dim i As Integer: i = 1
Dim vDate As Variant
Dim sNum As String
strSQL = "SELECT TML.[SERIAL NUMBER], TML.[DATA PLATE DATE] FROM [Tool Master List] AS TML WHERE (((TML.[DATA PLATE DATE]) Is Null));"
Set rst = db.OpenRecordset(strSQL, dbOpenDynaset)
With rst
If Not (.BOF And .EOF) Then
.MoveLast: .MoveFirst
Do Until .EOF
sNum = ![SERIAL NUMBER].Value
vDate = DLookup("[ACCEPT DATE]", "Tool information", "[SERIAL NUMBER]='" & sNum & "'")
Debug.Print i, sNum, vDate
If Not (IsNull(vDate) Or IsEmpty(vDate)) Then
vDate = CDate(vDate)
.Edit
![DATA Plate Date] = vDate '//FAILS-LOCKS UP RIGHT HERE WITHOUT and ERROR
.Update
End If
.MoveNext
i = i + 1
sNum = vbNullString
vDate = Null
DoEvents
Loop
End If
.Close
End With
Set rst = Nothing
Set db = Nothing
exit_sub:
Exit Sub
err_trap:
Debug.Print Err.Number, Err.Description
Stop
Resume
End Sub
Is it possible the item you are trying to update is being edited by a user? Have you considered linking the SharePoint table and performing an update query instead?
I have a query that has CustID with mutiple Business affiliated with the CustID. I can't use Dlookup because it only returns one variable. I want to show on a form that for this custID, here are all the businesses it's affiliated it. I want the Businesses to show up into a field (business) in another table on the form.
I started out by this
Public Sub OpenRecordset()
Dim db As Database
Dim rs As Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("Q:businesses")
Do While Not rs.EOF
T:Custinfo!business = NAME (I am lost in between on how to identify the custid and place the businesses into the table field as a Dlookup)
rs.movenext
Loop
rs.Close
Set rs = Nothing
db.Close
End Sub
I keep looking at other examples but can't seem to tie together where the dlookup replacement will take place and how will you have to put this on a form as a datasheet?
You don't need a DLookup. You could do one of two things:
1) Use a listbox and set the recordsource equal to your query (assuming Q:businesses has been appropriately defined to give the businesses as a result)
2) Still need your query to be appropriate, but you could create a string with all of the businesses in it:
Public Sub OpenRecordset()
Dim db As Database
Dim rs As Recordset
Dim StrBusinesses As String
Set db = CurrentDb
Set rs = db.OpenRecordset("qryBusinesses")
If rs.EOF and rs.BOF Then
MsgBox("No businesses exist for this Customer")
Exit Sub 'Or do whatever else you want if there are no matches
Else
rs.MoveFirst
End If
StrBusinesses = ""
Do While Not rs.EOF
StrBusinesses = StrBusinesses & rs!Business & ", "
rs.movenext
Loop
rs.Close
StrBusinesses = Left(StrBusinesses, Len(StrBusinesses) - 2)
Forms!MyForm.MyField = StrBusinesses 'Set the field equal to the string here
Set rs = Nothing
db.Close
End Sub
Of course this assumes that the query "Q:Business" is defined to get the appropriate info such as:
SELECT custID, business FROM tblBusinesses WHERE custID = X
where "X" is the custID you are looking for.
If you need to set the query dynamically, you will need to set a querydef.
EDIT to include querydef code***********************
Also changed the name of the query to "qryBusinesses" in the code above and below as I'm not sure whether you can make a query with a colon in it.
To set the querydef, put this at the beginning of the code:
Dim qdf As QueryDef
Set qdf = CurrentDb.QueryDefs("qryBusinesses")
qdf.SQL = "SELECT custID, business FROM tblBusinesses" _
& " WHERE custID = " & Forms!MyForm.CustID 'replace with actual form and field
This assumes that i) qryBusinesses exists already,
ii) custID is a number field
EDIT**************
If you define the query to look at the form itself, you would not need to set the sql, so if the query were defined (either in VBA or through the query wizard) as:
qdf.sql = "SELECT custID, business FROM tblBusinesses" _
& " WHERE custID = Forms!MyForm.CustID"
then you would not need to redefine the sql. However, it is a bit more dynamic to put the custID into the qdf itself as it is easier to debug any issues as you can see the exact sql that is being run in the original method.
Using VBA, how can I search for a text string, for example "CHIR", in a table called "ServiceYES", in the field "Service".
After that, I would like to save the neighboring field for all the rows that "CHIR" exists in the table "ServicesYES". The "ServiceYES" table is below:
I basically, want to find all the "CHIR" in "Service" column and then save the names which are on the left of the CHIR, eg "FRANKL_L", "SANTIA_D" as an array.
Thanks for all your help in advance.
Start by creating a SELECT query.
SELECT Code_Perso
FROM ServicesYES
WHERE Service = 'CHIR';
Use SELECT DISTINCT Code_Perso if you want only the unique values.
Add ORDER BY Code_Perso if you care to have them sorted alphabetically.
Once you have a satisfactory query, open a DAO recordset based on that query, and loop through the Code_Perso values it returns.
You don't need to load them directly into your final array. It might be easier to add them to a comma-separated string. Afterward you can use the Split() function (assuming you have Access version >= 2000) to create your array.
Here's sample code to get you started. It's mostly standard boiler-plate, but it might actually work ... once you give it "yourquery".
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strItems As String
Dim varItems As Variant
Set db = CurrentDb
Set rs = db.OpenRecordset("yourquery", dbOpenSnapshot)
With rs
Do While Not .EOF
strItems = strItems & "," & !Code_Perso
.MoveNext
Loop
.Close
End With
If Len(strItems) > 0 Then
' discard leading comma '
strItems = Mid(strItems, 2)
varItems = Split(strItems, ",")
Else
MsgBox "Oops. No matching rows found."
End If
Set rs = Nothing
Set db = Nothing
I tested this and it seems to work. This function will pull all records where ServiceYes='CHIR' and dump the Code_Person value into an array which it will return:
Function x() As String()
Dim rst As Recordset
Set rst = CurrentDb.OpenRecordset( _
"Select * from ServiceYES where Service='CHIR'")
Dim Arr() As String
Dim i As Integer
While rst.EOF = False
ReDim Preserve Arr(i)
Arr(i) = rst.Fields("Code_Person")
i = i + 1
rst.MoveNext
Wend
x = Arr
End Function
Sample Usage:
Debug.Print x()(0)
Paolo,
Here is something I threw together in a few minutes. You can add it to the VBA editor in a module. It uses a trick to get the RecordCount property to behave properly. As for returing the array, you can update the function and create a calling routine. If you need that bit of code, just post a comment.
Thanks!
Option Compare Database
Function QueryServiceYES()
Dim db As Database
Dim saveItems() As String
Set db = CurrentDb
Dim rs As DAO.Recordset
Set rs = db.OpenRecordset("SELECT Code_Perso, Service, Favorites " & _
"FROM ServiceYES " & _
"WHERE Service = 'CHIR'")
'bug in recordset, MoveFirst, then MoveLast forces correct invalid "RecordCount"
rs.MoveLast
rs.MoveFirst
ReDim Preserve saveItems(rs.RecordCount) As String
For i = 0 To rs.RecordCount - 1
saveItems(i) = rs.Fields("Code_Perso")
rs.MoveNext
Next i
'print them out
For i = 0 To UBound(saveItems) - 1
Debug.Print saveItems(i)
Next i
rs.Close
Set rs = Nothing
db.Close
Set db = Nothing
End Function