I have tried every suggestion I can find on forums but my code is getting messy!
I am using Microsoft Access (Office 365) my computer is in French, I have English installed as a secondary language.
I want to find all sales records from tblEtsySales for the second quarter of the year. I am summing the records from the field TotalReceived using DSUM and want to filter by date. I get an unexpected amount returned when it should be zero.
Here is my code:
Dim Q2 As Currency
Dim Quarter2 As String
Quarter2 = "[Sale Date] BETWEEN #01/04/2017# And #30/06/2017#"
If IsNull(Q2 = DSum("[TotalReceived]", "tblEtsySales", Quarter2)) = True Then
MsgBox "No data for the second quarter."
txtQ2.Value = ""
Else
Q2 = DSum("[TotalReceived]", "tblEtsySales", Quarter2)
txtQ2.Value = Q2
End If
Your expression #01/04/2017# is read as 2017-01-04.
So do this:
Dim Q2 As Currency
Dim Quarter2 As String
Dim Date1 As Date
Dim Date2 As Date
Date1 = #04/01/2017#
Date2 = #06/30/2017# ' You can type it differently, but VBA will correct it.
Quarter2 = "[Sale Date] BETWEEN #" & Format(Date1, "yyyy\/mm\/dd") & "# And #" & Format(Date2, "yyyy\/mm\/dd") & "#"
Q2 = DSum("[TotalReceived]", "tblEtsySales", Quarter2)
If Q2 = 0 Then
MsgBox "No data for the second quarter."
txtQ2.Value = Null
Else
txtQ2.Value = Q2
End If
You'd probably be better off passing data parameters to a procedure to make this more flexible, but if you only need it for Q2 into perpetuity...
Dim Q2 As Double
Dim Quarter2 As String
Quarter2 = "[Sale Date] BETWEEN #01/04/2017# And #30/06/2017#"
Q2=DSum("[TotalReceived]", "tblEtsySales", Quarter2)
if Q2=0 then
MsgBox "No data for the second quarter."
txtQ2.Value = ""
else
txtQ2.Value=Q2
end if
Related
I have been looking for some code that creates a calendar year and will take data from a table and place it in the corresponding date on the calendar. I found some code online (from an older version of access) that pretty much fit the bill, with some modifications it does exactly what I need it to do. Originally, the code pulled data from one table and it was set up to run on the current year. I use two queries, qr_SafetyCal and qr_SafetyCal2, to refine data from the one table. The first query prioritizes the data and eliminates multiple events on any given day. The second query uses the results from the first and specifies the year in the query criteria.
The code works flawlessly as long as I set the year criteria in the qr_SafetyCal2 and specify the first day, ex. 1/1/2017 (datStart) in the underlying code of the calendar year I want displayed.
After getting the code squared away I created a pop up form the user to select the year for the report but when I run the report I get the following error, Runtime Error 3061 too few parameters expected 1.
From what I have been able to research, I believe I changed the dynamic of the code when I referenced the form in the query criteria that the DAO Recordset Used.
As I understand it, the criteria in the query is not passed to the rs and therefore needs to be declared in the code. What I can't figure out is how to declare the variables in the code through reference to the form. I hope that makes some sense to somebody, long explanation but hard to describe something you don't understand.
Below is all the code and you will see some things I've rem'd out that I have tried but did not work. Any help would be greatly appreciated. I apologize ahead of time if the code is not formatted correctly.
Option Compare Database
Option Explicit
Private m_strCTLLabel As String
Private m_strCTLLabelHeader As String
Private colCalendarDates As Collection
Function getCalendarData() As Boolean
Dim rs As DAO.Recordset
Dim strDate As String
Dim strCode As String
Dim i As Integer
'Dim qdf As DAO.QueryDef
'Set qdf = CurrentDb.QueryDef("qr_SafetyCal2")
'qdf.Parameters("[Forms]![fr_SafetyCal]![cboYear]") = [Forms]![fr_SafetyCal]![cboYear]
'Set rs = qdf.OpenRecordset("qr_SafetyCal2", dbOpenDynaset)
Set rs = CurrentDb.OpenRecordset("qr_SafetyCal2", dbOpenDynaset)
Set colCalendarDates = New Collection
With rs
If (Not .BOF) Or (Not .EOF) Then
.MoveLast
.MoveFirst
End If
If .RecordCount > 0 Then
For i = 1 To .RecordCount
strDate = .Fields("Date")
strCode = .Fields("ShortName")
colCalendarDates.Add strCode, strDate
.MoveNext
Next i
End If
.Close
End With
'Return of dates and data collection form qr_SafetyCal2
Set rs = Nothing
End Function
Public Sub loadReportYearCalendar(theReport As Report)
Dim i As Integer
Dim datStart As Date
Dim rptControl As Report
m_strCTLLabel = "labelCELL"
m_strCTLLabelHeader = "labelDAY"
'Load calendar data for the specified year into the collection
Call getCalendarData
With theReport
'Get the first month of the specified year
datStart = "1/1/2017" '"1/1/" & Year(Date), "1/1/" & Forms!
[fr_SafetyCal]![cboYear], Forms![fr_SafetyCal]![txtCalYear]
'Add the specified year to the report's label
.Controls("labelCalendarHeaderLine2").Caption = Year(datStart) & "
iCalendar"
For i = 1 To 12
'Set pointer to subreport control hosting the mini-calendar
Set rptControl = .Controls("childCalendarMonth" & i).Report
'Run procedure to populate control with it's respective year
Call loadReportCalendar(rptControl, datStart)
'Reset and obtain first day of the following month
datStart = DateAdd("m", 1, datStart)
Next i
End With
'Clean up
Set colCalendarDates = Nothing
Set rptControl = Nothing
End Sub
Public Sub loadReportCalendar(theReport As Report, Optional StartDate As
Date, Optional theHeaderColor As Variant)
Dim i As Integer
Dim intCalDay As Integer
Dim datStartDate As Date
Dim intWeekDay As Integer
datStartDate = StartDate
intWeekDay = Weekday(datStartDate)
With theReport
.Controls("labelMONTH").Caption = Format(StartDate, "mmmm")
'Change the day label's backcolor if necessary
If Not (IsMissing(theHeaderColor)) Then
For i = 1 To 7
.Controls("labelDayHeader" & i).BackColor = theHeaderColor
Next
End If
For i = 1 To 42
With .Controls(m_strCTLLabel & i)
If (i >= intWeekDay) And (Month(StartDate) =
Month(datStartDate)) Then
If (datStartDate = Date) Then
.BackColor = 14277081
End If
On Error Resume Next
Dim strCaption As String
Dim strKey As String
strKey = datStartDate
strCaption = ""
strCaption = colCalendarDates.Item(strKey)
colCalendarDates.Remove strKey
'Set back color to grean on days in the past that have
no corresponding event
If (datStartDate < Date) And (strCaption = vbNullString) Then
.Caption = Day(datStartDate)
.Bold = False
.BackColor = vbGreen
.ForeColor = vbWhite
.Heavy = True
'Do not set a back color for days in the future
ElseIf (datStartDate > Date) And (strCaption = vbNullString) Then
.Caption = Day(datStartDate)
.Bold = False
'Set the corresponding labels and formats for each specified event
Else
.Caption = strCaption
.Bold = True
Select Case strCaption
Case "FA"
.BackColor = vbYellow
.ForeColor = 0
.LeftMargin = 0
.TextAlign = 2
Case "FAM"
.BackColor = vbYellow
.ForeColor = 0
.LeftMargin = 0
.TextAlign = 2
.Heavy = True
Case "LTA"
.BackColor = vbRed
.ForeColor = vbWhite
.LeftMargin = 0
.TextAlign = 2
Case "MED"
.BackColor = vbRed
.ForeColor = vbWhite
.LeftMargin = 0
.TextAlign = 2
End Select
End If
datStartDate = DateAdd("d", 1, datStartDate)
Else
.Caption = ""
End If
End With
Next i
End With
End Sub
Here is SQL for the two queries, the first is qr_SafetyCal and the second is qr_SafetyCal2:
SELECT tb_CaseLog.Date, Max(tb_Treatment.Priority) AS MaxOfPriority,
Count(tb_Treatment.TreatmentID) AS CountOfTreatmentID
FROM tb_Treatment INNER JOIN tb_CaseLog ON tb_Treatment.TreatmentID =
tb_CaseLog.Treatment
GROUP BY tb_CaseLog.Date;
SELECT qr_SafetyCal.Date, tb_Treatment.ShortName,
qr_SafetyCal.CountOfTreatmentID AS [Count], Year([Date]) AS CalYear
FROM qr_SafetyCal INNER JOIN tb_Treatment ON qr_SafetyCal.MaxOfPriority =
tb_Treatment.Priority;
No need to reference QueryDef.
Open the recordset object with filtered dataset by referencing the combobox like:
Set rs = CurrentDb.OpenRecordset("SELECT * FROM qr_SafetyCal2 WHERE CalYear=" & [Forms]![fr_SafetyCal]![cboYear], dbOpenDynaset)
or if the code is behind the form:
Set rs = CurrentDb.OpenRecordset("SELECT * FROM qr_SafetyCal2 WHERE CalYear=" & Me.[cboYear], dbOpenDynaset)
Both examples assume the field is a number type.
If there is no field in query with the year value, it can be extracted from date value field in the VBA construct:
Set rs = CurrentDb.OpenRecordset("SELECT * FROM qr_SafetyCal2 WHERE Year([YourFieldnameHere])=" & [Forms]![fr_SafetyCal]![cboYear], dbOpenDynaset)
Code for setting datStart variable:
'Get the first month of the specified year
datStart = "1/1/" & Forms![fr_SafetyCal].[cboYear]
I have the following code and have been asked to remove the user input box and automate pulling in files. One issue is if the current day is Monday, we would need Friday's date pulled in (not yesterday). I am sorry for being extremely basic, but I believe I would need to replace InputBox("Input Date") with something like DateAdd(Day, DateDiff(Day, 1, GETDATE()), 0) - but it does not like Day or DD.
Any ideas? (and thank you for being patient with me in advance)
DoCmd.SetWarnings False
Dim InvDateStr As String
Dim InvDate As Date
Dim Directory_Sheets As String
Dim filename_sheets As String
Dim db As Database
Dim rst As DAO.Recordset
Dim startdate As Date
Dim EndDate As Date
'startdate = #9/23/2010#
'enddate = #1/12/2011#
'InvDate = startdate
'Do Until InvDate = enddate
InvDateStr = InputBox("Input Date")
If InvDateStr = "" Then
Exit Sub
End If
InvDate = CDate(InvDateStr)
Directory_Sheets = FilePath & "Inventory_Surveys\"
On Error Resume Next
' Pull Stores with Inventory
I'm only going to do the date part, you can implement it:
InvDate = Date - 1 'Yesterday
Do While Weekday(InvDate, vbMonday) > 5 'Saturday or Sunday
InvDate = InvDate - 1
Loop
I want to get MAX purchase date from a query.
I have written code which can show date in message box. But problem is that the date is not showing exactly as entered in the table. In the table date is 11-04-17, but in the message box date is shown 30-12-99.
My Code is:
Dim dbforPurdate As Database
Dim rsforPurdate As Recordset
Dim vmedid As String
Dim dtpurtbl As Date
Dim Qryfordate As String
vmedid = Me.MedID
Set dbforPurdate = CurrentDb
'Qryfordate = "SELECT Purchaset.[Purchase Date] AS PurDate, PurchaseDetailt.[Receipt No], PurchaseDetailt.MedID, PurchaseDetailt.BatchNo FROM Purchaset INNER JOIN PurchaseDetailt ON Purchaset.[Receipt No] = PurchaseDetailt.[Receipt No]"
Set rsforPurdate = dbforPurdate.OpenRecordset("Qryfordate")
dtpurtbl = Nz(DMax("[Purchase Date]", "qryfordate", [MedID] = "'" & vmedid & "'"), 0)
MsgBox Format(dtpurtbl, " dd/mm/yy ")
Your DMax() is not finding a value which returns Null and therefore the Nz() returns 0 and the Format() function converts 0 to 30-12-99.
The DMax() shows syntax errors and I am surprised you do not get runtime error. It is missing quote mark in front of [MedID] and has an extra quote mark after = sign.
Is MedID really a text type field?
DMax("[Purchase Date]", "qryfordate", "[MedID] = '" & vmedid & "'")
If you want the message box to not show the funky date value:
MsgBox IIf(dtpurtbl = 0, "No Date", Format(dtpurtbl, " dd/mm/yy "))
I am attempting to simply sum together two textboxes via the Form_Timer(). I am able to subtract,
txtmyqueusedtime = Now()
txtmyqueduration = Format([txtmyqueusedtime] - [txtmyquestarttime], "hh:nn:ss")
but when I attempt to add it comes back concatenated.
txtmyquecmbtimer = [txtmyqueduration] + [txtmyquecmbquedur]
EX: if I need 00:00:03 + 00:00:01 added I need to return 00:00:04. Instead I am returning 00:00:0300:00:01
Details:
I have tried many different ways to get it to sum properly, unfortunately I've been met with a Type Mismatch error each time. [txtmyquecmbtimer] should be adding a persons queued time (static) with current duration of the form being opened [txtmyqueduration].
Thanks for any help -- Happy to supply additional details if needed.
UPDATE -- Figured this one out finally
*Private Sub Form_Timer()
Dim combtime As Date
Dim duration As Date
Dim sumtime As Date
txtmyqueusedtime = Now()
txtmyqueduration = Format([txtmyqueusedtime] - [txtmyquestarttime], "hh:nn:ss")
If IsNull(DLookup("CombinedDuration", "Agent_Queue", "SysAcct = '" & txtmyquesysacct & "'")) Then
Me.txtmyquecmbtimer.Value = [txtmyqueduration]
Else
combtime = CDate(DLookup("CombinedDuration", "Agent_Queue", "SysAcct = '" & txtmyquesysacct & "'"))
duration = CDate(txtmyqueduration)
sumtime = duration + combtime
Me.txtmyquecmbtimer.Value = sumtime
End If
End Sub*
Use DateDiff() to subtract datetimes, and DateAdd() to add to an interval to a date
Private Sub Form_Timer()
Dim combtime As Date
Dim duration As Long
Dim sumtime As Date
txtmyqueusedtime = Now()
txtmyqueduration = DateDiff("S", [txtmyqueusedtime], [txtmyquestarttime])
If IsNull(DLookup("CombinedDuration", "Agent_Queue", "SysAcct = '" & txtmyquesysacct & "'")) Then
Me.txtmyquecmbtimer.Value = [txtmyqueduration]
Else
combtime = CDate(DLookup("CombinedDuration", "Agent_Queue", "SysAcct = '" & txtmyquesysacct & "'"))
duration = Clng(txtmyqueduration)
sumtime = DateAdd ("S", duration, combtime)
Me.txtmyquecmbtimer.Value = sumtime
End If
End Sub
Note: duration is a nuber of seconds, not a Time 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.