I need help, because when I run de code, Error appears when some date field is empty. I have a table with information and I run this code since the generator.
Eliminate #Error when I run the code vba in ACCESS
I will grateful for you help.
Option Compare Database
Public Function WorkingDays2(FECHA_DE_VALIDACION_FA As Date, FECHA_IMPRESIÓN As Date) As Integer
'....................................................................
' Name: WorkingDays2
' Inputs: StartDate As Date
' EndDate As Date
' Returns: Integer
' Author: Arvin Meyer
' Date: May 5,2002
' Comment: Accepts two dates and returns the number of weekdays between them
' Note that this function has been modified to account for holidays. It requires a table
' named tblHolidays with a field named HolidayDate.
'....................................................................
Dim intCount As Integer
Dim rst As DAO.Recordset
Dim DB As DAO.Database
Set DB = CurrentDb
Set rst = DB.OpenRecordset("SELECT [DIAFESTIVO] FROM DIASFESTIVOS", dbOpenSnapshot)
'StartDate = StartDate + 1
'To count StartDate as the 1st day comment out the line above
intCount = 0
Do While FECHA_DE_VALIDACION_FA <= FECHA_IMPRESIÓN
rst.FindFirst "[DIAFESTIVO] = #" & FECHA_DE_VALIDACION_FA & "#"
If Weekday(FECHA_DE_VALIDACION_FA) <> vbSunday And Weekday(FECHA_DE_VALIDACION_FA) <> vbSaturday Then
If rst.NoMatch Then intCount = intCount + 1
End If
FECHA_DE_VALIDACION_FA = FECHA_DE_VALIDACION_FA + 1
Loop
WorkingDays2 = intCount
Exit_WorkingDays2:
Exit Function
WorkingDays2 = intCount
Exit_WorkingDays2:
Exit Function
Err_WorkingDays2:
Select Case Err
Case Else
MsgBox Err.Description
Resume Exit_WorkingDays2
End Select
End Function
It depends a bit where you are calling this function from within your database. Probably as a calculated field in a query? Something like this:
WorkingDays: WorkingDays3([YourDateField])?
Try this instead:
WorkingDays: WorkingDays3(Nz([YourDateField],Date())
Your original question included code for a function named WorkingDays3, which takes one date parameter.
Your illustration shows a function named WorkingDays2, which takes two date parameters.
I think you will need to give more detailed information about the data you are working with, and under which conditions you are seeing the #Error.
Related
I have just inherited a new database to maintain. But one of the tables is, well, not great. I could write a complex query to fix this problem, but it would be long and tedious. I am wondering if there is an easier way to it?
The table looks like this :
Name
Data point
Date1
date 2
date 3
date 4
...
dateN
alpha
yes
date
date
date
date
...
date
beta
no
date
date
date
date
...
date
Thing is , what I need it to look like is this :
Name
Data point
DateCat
Date
alpha
yes
date1
date
beta
no
date2
date
alpha
yes
date3
date
beta
no
date4
date
alpha
yes
date2
date
beta
no
date1
date
Now a crosstab would allow me to go from what I want to what I have, is there an easy way to do the reverse, or is this a "Get your hands dirty and do it manually" situation? I am considering exporting the table, throwing it in to pandas and manipulating it that way, because I know I can do it there. Hoping Access has something built in for this?
Whilst Access doesn't have a single built-in function to do what you want, it is relatively easy to create something using VBA that loops the fields in the first table to output the data as required. Something like:
Sub sUnXTabData()
On Error GoTo E_Handle
Dim db As DAO.Database
Dim rsSteer As DAO.Recordset
Dim rsData As DAO.Recordset
Dim intCount As Integer
Dim intLoop1 As Integer
Set db = CurrentDb
Set rsSteer = db.OpenRecordset("SELECT * FROM tblXTab;")
If Not (rsSteer.BOF And rsSteer.EOF) Then
db.Execute "DELETE * FROM tblNotXTab;"
Set rsData = db.OpenRecordset("SELECT * FROM tblNotXTab WHERE 1=2;")
intCount = rsSteer.Fields.Count - 1
Do
For intLoop1 = 2 To intCount
rsData.AddNew
rsData("Name") = rsSteer("Name")
rsData("Datapoint") = rsSteer("Datapoint")
rsData("DateCat") = rsSteer.Fields(intLoop1).name
rsData("Date") = rsSteer.Fields(intLoop1)
rsData.Update
Next intLoop1
rsSteer.MoveNext
Loop Until rsSteer.EOF
End If
sExit:
On Error Resume Next
rsSteer.Close
rsData.Close
Set rsSteer = Nothing
Set rsData = Nothing
Set db = Nothing
Exit Sub
E_Handle:
MsgBox Err.Description & vbCrLf & vbCrLf & "sUnXTabData", vbOKOnly + vbCritical, "Error: " & Err.Number
Resume sExit
End Sub
Please note that Name and Date are reserved words in Access, so you should change them.
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 trying to make a Microsoft Access query depend on a value in another form's textbox.
This is the criteria, as it is now. Basically, any date between April 1st 2014, and March 31st 2015. This works well.
>=#2014-04-01# And <#2015-04-01#
I'd like to have a textbox with the year (with the current example 2014), and make the query criteria (2014, 2014+1) depend on this value.
I've tried to split the above syntax, then concatenate in the criteria, as such:
">=#" & "2014" & "-04-01# And <#" & "2015" & "-04-01#"
And I get an error "Data types in the criterion expression are incompatible".
1. Is it possible to concatenate in the query criteria?
I have also tried the SQL CONCAT(string1,string2,string3,..), to no avail.
If this is possible, then I guess I can use [Forms]![Form1].[Textbox1] and ([Forms]![Form1].[Textbox1] + 1) to replace the years.
If this is not possible...
2. Is there a better way to make the query criteria dynamic?
I tried to make the following solution work by creating a module with similar code:
Private m_varQueryParam As Variant
Public Function SetQueryParam(ByVal sValue as Variant)
m_varQueryParam = sValue
End Function
Public Function GetQueryParam() As Variant
GetQueryParam = m_varQueryParam
End Function
Query:
SELECT * FROM tblYourTable WHERE [FilterField] = GetQueryParam()
The VBA Code to launch the query will look like this.
SetQueryParam "your value here"
DoCmd.OpenQuery "qryYourQueryHere"
But I simply do not understand how to get this to work.
EDIT: I created a simple access database, to try to get this to work.
Textbox1, default value =Date()
bSave, button
tDateInfo, table: date (date/time), info (text) with random dates and info.
Query1:
SELECT tDateInfo.date, tDateInfo.info
FROM tDateInfo
WHERE (((tDateInfo.date)=GetQueryParam()));
Here's the form's vba code
Option Compare Database
Private Sub bSave_Click()
sValue = Me.TextBox1.Value
SetQueryParam (sValue)
End Sub
Here's the modules vba code
Option Compare Database
Option Explicit
'is this necessary?
Private m_varQueryParam As Variant
Public Function SetQueryParam(ByVal sValue As Variant)
m_varQueryParam = sValue
End Function
Public Function GetQueryParam() As Variant
GetQueryParam = m_varQueryParam
End Function
And the query criteria is GetQueryParam()
Thank you for your help.
Handling parameters and form fields is a little tricky with VBA. I created a simple table similar to yours as follows:
CREATE TABLE DateCalc (
ID AutoNumber,
FilterField DateTime
)
The following code will return your desired results:
Sub testthis()
Dim db As dao.database
Set db = CurrentDb ' use current database
Dim qd As dao.QueryDef
Set qd = db.CreateQueryDef("") ' create anaonymous querydef
' the SQL statement correctly concatenates the parameter (Useyear) and mm/dd strings
qd.sql = "SELECT * FROM DateCalc WHERE [FilterField] >= [UseYear]" & "-04-01 And [FilterField] < [UseYear]+1" & "-04-01"
qd!UseYear = Forms!DateCalc!txtYear ' set the value of se year from the Form WHICH MUST BE OPEN
' AND the TetBox filled with the year you desire - 2014 for this example.
Dim rs As dao.recordSet
Set rs = qd.OpenRecordset
MsgBox "ID=" & rs(0) & ", Date=" & rs(1)
End Sub
NEW VERSION
Sorry, there were a couple of date formatting problems with the first solution that the following code resolves. There are a number of other reasons for the error, so be sure the FormName is "DateCalc" and the TextBox is named "txtYear".
You should be able to generalize the following code for all your queries (do those actually work?). I pass the TableName in now as an example:
Sub DateFilter(TableName As String)
Dim db As dao.database
Set db = CurrentDb ' use current database
Dim qd As dao.QueryDef
Set qd = db.CreateQueryDef("") ' create anaonymous querydef
' the SQL statement correctly concatenates the parameter (Useyear) and mm/dd strings
Dim UseYear As Integer
UseYear = Forms!DateCalc!txtYear
Dim BegDate As Date
BegDate = CDate(UseYear & "-04-01")
Dim EndDate As Date
EndDate = CDate((UseYear + 1) & "-04-01")
qd.sql = "SELECT * FROM " & TableName & " WHERE [FilterField] >= [UseBegDate] And [FilterField] < [UseEndDate]"
qd!UseBegDate = BegDate
qd!UseEndDate = EndDate
Dim rs As dao.recordSet
Set rs = qd.OpenRecordset
Do While Not rs.EOF
MsgBox "ID=" & rs(0) & ", Date=" & rs(1)
rs.MoveNext
Loop
End Sub
I think I found a solution.
The following code defines the SQL as I require it, and changes the SQL for the Access query.
It's not ideal, because it requires me to rewrite all the SQL for the queries, but it works.
Sub ChangeQuery()
Dim Year, sqlTwo, StartDate, EndDate As String
Year = Me.txtYear.Value
StartDate = "4/1/" & Year
EndDate = "4/1/" & (Year + 1)
sqlTwo = "SELECT DateCalc.ID, DateCalc.FilterField FROM DateCalc WHERE (((DateCalc.FilterField)>=#" & StartDate & "# And DateCalc.FilterField<#" & EndDate & "#));"
tbTest.Value = sqlTwo
Dim oDB As Database
Dim oQuery As QueryDef
Set oDB = CurrentDb
Set oQuery = oDB.QueryDefs("Query1")
oQuery.SQL = sqlTwo
Set oQuery = Nothing
Set oDB = Nothing
End Sub
Private Sub Button_Click()
ChangeQuery
End Sub
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.