I am wondering if it is possible to control the time entered into MS Access textbox. Eg, only allow user to enter time in half hourly interval (08:30, 10:00, 13:30) as I do not want to end up with weird timing input.. (i.e 13:37, 16:42). Tried to use calculated control but doesn't seem to be working very well. Any suggestions or advice, please?
Calculated control in my textbox
=IIf((Minute([TxtStartTime1]) Mod 30=0),[TxtStartTime1],"00:00")
Below is a screen capture of my form.
Yes, that is possible, but it takes a little - actually that much, that I wrote an article on how-to:
Entering 24-hour time with input mask and full validation in Microsoft Access
It includes all the code needed to set the inputmask, validation, click and keypress events, as well as handling the form error - too much to post here.
Code is also on GitHub: VBA.TimeEntry
To round the time, you may include this function:
Public Function RoundTime( _
ByVal datDate As Date) _
As Date
Const cintMult As Integer = 24 '1 hour round
' Const cintMult As Integer = 48 '30 minute round
' Const cintMult As Integer = 96 '15 minute round
' Const cintMult As Integer = 144 '10 minute round
' Const cintMult As Integer = 288 '5 minute round
RoundTime = CVDate(Int(datDate * cintMult + 0.5) / cintMult)
End Function
You can round entered time for instance in BeforeUpdate event of your control. For rounding I use this VBA function:
Public Function TimeRoundMinutes(dtUnrounded As Date, Optional intRoundTo As Integer = 30, Optional intOption As Integer) As Date
'rounds time of provided date to specified in intRoundTo number of minutes. intOption:
'1 - down
'2 - up
'0 or anything else - to the nearest part
Dim intMins As Integer
If intRoundTo <= 0 Then
intRoundTo = 1
ElseIf intRoundTo > 60 Then
intRoundTo = 60
End If
intMins = Minute(dtUnrounded)
Select Case intOption
Case 1
intMins = Int(intMins / intRoundTo) * intRoundTo
Case 2
intMins = -Int(-intMins / intRoundTo) * intRoundTo
Case Else
intMins = Round(intMins / intRoundTo) * intRoundTo
End Select
If intMins = 60 Then
TimeRoundMinutes = DateAdd("h", 1, Int(dtUnrounded) + TimeSerial(Hour(dtUnrounded), 0, 0))
Else
TimeRoundMinutes = Int(dtUnrounded) + TimeSerial(Hour(dtUnrounded), intMins, 0)
End If
End Function
Related
To make my life much easier working with my data I set 3 columns of same date content. The first displays in the format mm/dd/yyyy, second in the format of yyyy-mm and the third in the format yyyy-q.
I did it purposely due to my reports. Sometimes I need to create monthly, quarterly, yearly etc. Usually I work with a form where I invite the user select start and end date and by a click of a button run a report. This report extracts a query where I specify on the date section to pull all information between start and end date. This time I want to do the same procedure but instead of start and end date - I want the user to select which quarter he wants so that the query will pull all information regarding this quarter. What do I specify in the criteria to archive this?
Filter on
DatePart("q", [YourDateField])
or
Format([YourDateField], "yyyyq")
To obtain the first and last date of a quarter, given the year and the quarter, you can use these expressions:
DateQuarterFirst = DateSerial(Y, 1 + 3 * (Q - 1), 1)
DateQuarterLast = DateSerial(Y, 1 + 3 * Q, 0)
If you have a date of the quarter, you can these functions to obtain the first and last date of the quarter of that date:
Public Function DateThisQuarterFirst( _
Optional ByVal datDateThisQuarter As Date) As Date
Const cintQuarterMonthCount As Integer = 3
Dim intThisMonth As Integer
If datDateThisQuarter = 0 Then
datDateThisQuarter = Date
End If
intThisMonth = (DatePart("q", datDateThisQuarter) - 1) * cintQuarterMonthCount
DateThisQuarterFirst = DateSerial(Year(datDateThisQuarter), intThisMonth + 1, 1)
End Function
Public Function DateThisQuarterLast( _
Optional ByVal datDateThisQuarter As Date) As Date
Const cintQuarterMonthCount As Integer = 3
Dim intThisMonth As Integer
If datDateThisQuarter = 0 Then
datDateThisQuarter = Date
End If
intThisMonth = DatePart("q", datDateThisQuarter) * cintQuarterMonthCount
DateThisQuarterLast = DateSerial(Year(datDateThisQuarter), intThisMonth + 1, 0)
End Function
Im using this function
Public Function ElapsedTime(Start As Date, Finish As Date) As String
'Calculates elapsed time between 2 date/times and
'parses it out into Hours-Minutes-Seconds in HH:MM:SS format
Dim HoursLapsed, SecondsLeft, MinutesLapsed, SecondsLapsed, TotalSeconds As Long
TotalSeconds = DateDiff("s", Start, Finish)
HoursLapsed = Int(TotalSeconds / 3600)
SecondsLeft = TotalSeconds Mod 3600
MinutesLapsed = Int(SecondsLeft / 60)
SecondsLapsed = SecondsLeft Mod 60
ElapsedTime = Format(HoursLapsed, "00") & ":" & Format(MinutesLapsed, "00") & ":" & Format(SecondsLapsed, "00")
End Function
This is my query
SELECT
ElapsedTime([Date_Faxed],[Date_Found]) AS Duration,
dbo_yard_request.Salesman,
dbo_yard_request.Make,
dbo_yard_request.Model,
dbo_yard_request.ID,
dbo_yard_request.Found2
FROM
dbo_yard_request
WHERE
(((dbo_yard_request.Found2)=True));
It works fine except i need to factor in the end of day at 5pm and start of new day at 8am.
For example
DATE_FAXED = 1/22/2015 4:45:22 PM
DATE_FOUND = 1/23/2015 8:55:13 AM
The elapsed time should be one hour and ten minutes, not 16 hours
I have a table that contains prices from several agents and from several airlines, they were divided into groups by weight charges.
Depending on the airport of departure (POL/C) and arrival (POD/C), I check all the prices and I have to use the best one. But to show the price alternatives.
Each airline has its own method of calculation, therefore I have to check.
Table contains the following information:
ID = AutoNumber, Long Integer
A/CODE = Number, Long Integer
AGENT = Text,
POL/C = Text,
POL = Text,
POD/C = Text,
POD = Text,
IATA = Text,
Airline = Text,
UPDATE = Date/Time, Short Date
EXPIRY DATE = Date/Time, Short Date
CURRENCY = Text,
M/M = Number, Double (Minimum weight accepted)
-45 = Number, Double (price for the weight between 1 and 45)
+45 = Number, Double (price for the weight starting from 45 to 100)
+100 = Number, Double (price for the weight starting from 100 to 300)
+300 = Number, Double (price for the weight starting from 300 to 500)
+500 = Number, Double (price for the weight starting from 500 to 1000)
+1000 = Number, Double (price for the weight starting from 1000)
FSC = Number, Double
SSC = Number, Double
ScGw = Yes/No, Yes/No
FREQUENCY = Text,
TT = Number, Long Integer
T/S = Yes/No, Yes/No
From the beginning it will have two weights as follows:
actual total weight (GW - gross weight)
calculated weight by volume (VW)
if GW > VW then..
calculation is based on the higher value (GW)
else
calculation is based on the higher value (VW)
example:
VW = 405 kgs and GW = 222 kgs then use higher value
FSC and SSC is added to the price if any.
Where is calculated on weight (VW) and If ScGw = Yes THEN the weight is different account and is calculated using (GW)
example:
Air freight = euro 0.25 / kgs (x 405 kgs VW)
Fuel + security = euro 1.1 / kgs (x 222 kgs GW)
If ScGw = No THEN calculate the normal VW
example:
Air freight = euro 0.25 / kgs (x 405 kgs VW)
Fuel + security = euro 1.1 / kgs (x 405 kgs VW)
If the calculation is made according to GW,
then add the FSC and SSC automatically and without having to count,
if ScGw = Yes / No
Values of GW and VW we have already calculated in another form and only need to be use.
airport of departure (POL/C) and arrival (POD/C) is already selected in another form.
If you can help me, as a few days simply fail to find any solution. I am writing full pages without any good result.
Thanks to all who respond.
I'm stuck at the moment and with the error:
Run-time error ‘3061’:
Too few parameters. Expected 2
I do not know what the problem is...
Public Sub CalculPret()
Dim da As Database
Dim rec As Recordset
Dim PolCboV As String
Dim PodCboV As String
Dim strSQL As String
Dim GrossWeight As Double
Dim VolumeWeight As Double
Dim CalcWeight As Double
Dim CalcWeightScGw As Double
Dim CalcPrice As Double
Dim TotalPrice As Double
PolCboV = [Forms]![DimensionsQry]![PolCbo]
PodCboV = [Forms]![DimensionsQry]![PodCbo]
strSQL = "SELECT Prices_List.ID, Prices_List.[A/CODE], Prices_List.AGENT, Prices_List.[POL/C], Prices_List.POL, Prices_List.[POD/C], Prices_List.POD, Prices_List.IATA, Prices_List.AIRLINE, Prices_List.UPDATE, Prices_List.[EXPIRY DATE], Prices_List.CURRENCY, Prices_List.[M/M], Prices_List.[-45], Prices_List.[+45], Prices_List.[+100], Prices_List.[+300], Prices_List.[+500], Prices_List.[+1000], Prices_List.FSC, Prices_List.SSC, Prices_List.ScGw, Prices_List.FREQUENCY, Prices_List.TT, Prices_List.[T/S]"
strSQL = strSQL & " FROM Prices_List"
strSQL = strSQL & " WHERE (((Prices_List.[POL/C])=PolCboV) AND ((Prices_List.[POD/C])=PodCboV)); "
Set da = CurrentDb
Set rec = da.OpenRecordset(strSQL)
If rec.RecordCount = 0 Then
rec.Close
Exit Sub
Else
GrossWeight = [Forms]![DimensionsQry]![Text34]
VolumeWeight = [Forms]![DimensionsQry]![Text36]
If GrossWeight > VolumeWeight Then
CalcWeight = GrossWeight
Else
If ScGw = "Yes" Then
CalcWeight = GrossWeight
Else
CalcWeight = VolumeWeight
End If
End If
rec.MoveFirst
Do Until rec.EOF
Select Case CalcWeight
Case 1 To 44
CalcPrice = rec![-45]
Case 45 To 99
CalcPrice = rec![+45]
Case 100 To 299
CalcPrice = rec![+100]
Case 300 To 499
CalcPrice = rec![+300]
Case 500 To 999
CalcPrice = rec![+500]
Case Is >= 1000
CalcPrice = rec![+1000]
End Select
If CalcWeight = GrossWeight Then
CalcPrice = CalcPrice + rec!FSC + rec!SSC
TotalPrice = CalcPrice * CalcWeight
Else
TotalPrice = (CalcPrice * CalcWeight) + ((rec!FSC + rec!SSC) * GrossWeight)
End If
MsgBox TotalPrice
rec.MoveNext
Loop
End If
rec.Close
End Sub
I have tried to rearrange your rules into execution sequence.
I have added the following variables:
CalcWeight: The weight to be used in the calculation
CalcPrice: The price to be used in the calculation
TotalPrice: Price based on weight, standard price, fuel and security
Does the following look about right?
If GrossWeight > VolumeWeight Then
CalcWeight = GrossWeight
Else
If ScGw = "Yes" Then
CalcWeight = GrossWeight
Else
CalcWeight = VolumeWeight
End If
End If
Select Case CalcWeight
Case 1 To 44
CalcPrice = Price(-45)
Case 45 to 99
CalcPrice = Price(+45)
Case 100 To 299
CalcPrice = Price(+100)
Case 300 To 499
CalcPrice = Price(+300)
Case 500 To 999
CalcPrice = Price(500)
Case Is >= 1000
CalcPrice = Price(1000)
End Select
' I am unclear about adding FSC and SSC to CalcPrice.
' It appears to be based on which weight is used but
' it may be more complicated.
If CalcWeight = GrossWeight Then
CalcPrice = CalcPrice + FSC + SSC
End If
TotalPrice = CalcPrice * CalcWeight
New section in response to extra question
I have two problems:
You do not say which statement gives the 3061 error although I suspect I know.
I have not used Access for some years.
Everything that follows is general advice that may help you isolate the cause of the error.
Issue 1
strSQL = "SELECT Prices_List.ID, Prices_List.[A/CODE], Prices_List.AGENT, Prices_List.[POL/C], Prices_List.POL, Prices_List.[POD/C], Prices_List.POD, Prices_List.IATA, Prices_List.AIRLINE, Prices_List.UPDATE, Prices_List.[EXPIRY DATE], Prices_List.CURRENCY, Prices_List.[M/M], Prices_List.[-45], Prices_List.[+45], Prices_List.[+100], Prices_List.[+300], Prices_List.[+500], Prices_List.[+1000], Prices_List.FSC, Prices_List.SSC, Prices_List.ScGw, Prices_List.FREQUENCY, Prices_List.TT, Prices_List.[T/S]"
I do not like long statements that run off the page. I would have typed this as:
strSQL = "SELECT Prices_List.ID, Prices_List.[A/CODE], Prices_List.AGENT, " & _
"Prices_List.[POL/C], Prices_List.POL, Prices_List.[POD/C], " & _
"Prices_List.POD, Prices_List.IATA, Prices_List.AIRLINE, " & _
"Prices_List.UPDATE, Prices_List.[EXPIRY DATE], Prices_List.CURRENCY, " & _
"Prices_List.[M/M], Prices_List.[-45], Prices_List.[+45], " & _
"Prices_List.[+100], Prices_List.[+300], Prices_List.[+500], " & _
"Prices_List.[+1000], Prices_List.FSC, Prices_List.SSC, " & _
"Prices_List.ScGw, Prices_List.FREQUENCY, Prices_List.TT, " & _
"Prices_List.[T/S]"
Issue 2
Do you need all these fields? When you have picked the best price you will need AGENT or A/CODE. If you do not need ID, IATA, AIRLINE, why select them?
Issue 3
You have a field CURRENCY which you do not use. Is this correct?
Issue 4
Set da = CurrentDb
I assume CurrentDb is a global variable because it is not declared or set within this subroutine.
Issue 5
Set rec = da.OpenRecordset(strSQL)
I have googled "Access Error 3061" and have received lots of questions and answers about this error. Perhaps one will help you.
If I understand correctly, Prices_List is not a table but a query with parameters and you have not included the parameters.
Issue 5
MsgBox TotalPrice
While you are trying to get your program working, Debug.Print is more useful than MsgBox.
Click on one of the early statements in this routine to place the cursor in it. Click F9. The statement will go brown to indicate it is a breakpoint.
Run your program in the normal way. When it gets to the brown statement, it will stop and display the module. The brown statement will be both brown and yellow. Brown because it is a breakpoint; yellow because it is the statement about to be executed. Click F8; one statement will be executed and the next statement will become the yellow one.
You can step through your program statement by statement checking what is happening. If you hover over a variable, its current value will be displayed. If a statement gives an error, you can change it and try again.
You can have as many breakpoints as you like. Clicking F5 causes the program to run until the next breakpoint. With F5 and F8 you can control which bits of your program you examine.
Debug.Assert rec!AGENT <> "Acme Inc" can be very useful if one part of your program is failing. This debug assert will stop the program if the agent is "Acme Inc". The syntax is Debug.Assert boolean expression. With the correct boolean expression you can stop your program where ever you want.
At the bottom of the editor screen you should see the Immediate window. If you do not, click Ctrl+G.
Debug.Print rec!AGENT & " " & TotalPrice
will output Acme Inc 543.21 to the Immediate Window and carry on. With MsgBox the program stops and you have to write down the value. The Immediate Window has a limit of two or three hundred lines which you can scroll up and down or copy to NotePad.
Summary
I hope the above helps. Best of luck.
the line
strSQL = strSQL & " WHERE (((Prices_List.[POL/C])=PolCboV) AND ((Prices_List.[POD/C])=PodCboV));"
should read
strSQL = strSQL & " WHERE (((Prices_List.[POL/C])='" & PolCboV & "') AND ((Prices_List.[POD/C])='" & PodCboV & "'));"
because PolCbov & PodCbov are variables in your code, you want their values in the SQL not their names
I have the following sub in Access 2003 to return the hours elapsed bewteen two datetime fields.
Function DateDifferenceHour(dateStart As Date, dateEnd As Date) As String
'Outputs Hours from two dates
Dim age_hour As Double
age_hour = DateDiff("h", dateStart, dateEnd)
DateDifferenceHour = age_hour
End Function
If I have the following: DateDifferenceHour("07/23/2005","07/23/2005 7:30:00 PM").
It correctly returns 19 hours, but in reality, the time elapsed is 19 hours and 30 minutes.
How can I modify it so it can round off to 20 hours?
Edit:
My original suggestion was "Compute the difference in minutes, divide by 60, and round the quotient to zero decimal places". However, #Jean-François Corbett showed me the limitation of that approach.
? DateDifferenceHour("07/23/2005 7:00:59 PM","07/23/2005 7:30:00 PM")
1
IOW my first attempt rounded a duration of 29 minutes and 1 second up to 1 hour, which is no good. So instead I suggest using the difference in seconds and dividing by 3600.
Function DateDifferenceHour2(dateStart As Date, dateEnd As Date) As String
'Outputs Hours from two dates
DateDifferenceHour2 = _
Format(DateDiff("s", dateStart, dateEnd) / 3600, "0")
End Function
? DateDifferenceHour2("07/23/2005 7:00:59 PM","07/23/2005 7:30:00 PM")
0
There is still the issue of which rounding approach you want.
I chose Format() thinking you would want 2.5 hours rounded up to 3.
The VBA Round() function uses round-to-even, so Round(2.5, 0) would give you 2.
We don't know which you want; you can tell us. Also, dateStart and dateEnd imply dateStart will not be greater than dateEnd. However, if it can be, consider how you want a negative duration "rounded" to the nearest hour. Here are some examples copied from the Immediate Window.
? Round(-2.5, 0)
-2
? Round(-1.5, 0)
-2
? Format(-2.5, "0")
-3
? Format(-1.5, "0")
-2
This works, without any unexpected rounding (aside from the precision of the Date type itself).
Function DateDifferenceHour(dateStart As Date, dateEnd As Date) As String
' Rounds .5's to nearest even integer.
'DateDifferenceHour = CStr( Round( _
' CDbl(dateEnd - dateStart) * 24 ) )
' Rounds .5's up.
DateDifferenceHour = Format( _
CDbl(dateEnd - dateStart) * 24, "0" )
End Function
I put two rounding options so that it rounds to whole numbers; pick your favourite. It's way better programming practice to round explicitly and transparently than having DateDiff implicitly apply its unusual rounding.
What is a good implementation of a IsLeapYear function in VBA?
Edit: I ran the if-then and the DateSerial implementation with iterations wrapped in a timer, and the DateSerial was quicker on the average by 1-2 ms (5 runs of 300 iterations, with 1 average cell worksheet formula also working).
Public Function isLeapYear(Yr As Integer) As Boolean
' returns FALSE if not Leap Year, TRUE if Leap Year
isLeapYear = (Month(DateSerial(Yr, 2, 29)) = 2)
End Function
I originally got this function from Chip Pearson's great Excel site.
Pearson's site
public function isLeapYear (yr as integer) as boolean
isLeapYear = false
if (mod(yr,400)) = 0 then isLeapYear = true
elseif (mod(yr,100)) = 0 then isLeapYear = false
elseif (mod(yr,4)) = 0 then isLeapYear = true
end function
Wikipedia for more...
http://en.wikipedia.org/wiki/Leap_year
If efficiency is a consideration and the expected year is random, then it might be slightly better to do the most frequent case first:
public function isLeapYear (yr as integer) as boolean
if (mod(yr,4)) <> 0 then isLeapYear = false
elseif (mod(yr,400)) = 0 then isLeapYear = true
elseif (mod(yr,100)) = 0 then isLeapYear = false
else isLeapYear = true
end function
As a variation on the Chip Pearson solution, you could also try
Public Function isLeapYear(Yr As Integer) As Boolean
' returns FALSE if not Leap Year, TRUE if Leap Year
isLeapYear = (DAY(DateSerial(Yr, 3, 0)) = 29)
End Function
I found this funny one on CodeToad :
Public Function IsLeapYear(Year As Varient) As Boolean
IsLeapYear = IsDate("29-Feb-" & Year)
End Function
Although I'm pretty sure that the use of IsDate in a function is probably slower than a couple of if, elseifs.
Late answer to address the performance question.
TL/DR: the Math versions are about 5x faster
I see two groups of answers here
Mathematical interpretation of the Leap Year definition
Utilize the Excel Date/Time functions to detect Feb 29 (these fall into two camps: those that build a date as a string, and those that don't)
I ran time tests on all posted answers, an discovered the Math methods are about 5x faster than the Date/Time methods.
I then did some optimization of the methods and came up with (believe it or not Integer is marginally faster than Long in this case, don't know why.)
Function IsLeapYear1(Y As Integer) As Boolean
If Y Mod 4 Then Exit Function
If Y Mod 100 Then
ElseIf Y Mod 400 Then Exit Function
End If
IsLeapYear1 = True
End Function
For comparison, I came up (very little difference to the posted version)
Public Function IsLeapYear2(yr As Integer) As Boolean
IsLeapYear2 = Month(DateSerial(yr, 2, 29)) = 2
End Function
The Date/Time versions that build a date as a string were discounted as they are much slower again.
The test was to get IsLeapYear for years 100..9999, repeated 1000 times
Results
Math version: 640ms
Date/Time version: 3360ms
The test code was
Sub Test()
Dim n As Long, i As Integer, j As Long
Dim d As Long
Dim t1 As Single, t2 As Single
Dim b As Boolean
n = 1000
Debug.Print "============================="
t1 = Timer()
For j = 1 To n
For i = 100 To 9999
b = IsYLeapYear1(i)
Next i, j
t2 = Timer()
Debug.Print 1, (t2 - t1) * 1000
t1 = Timer()
For j = 1 To n
For i = 100 To 9999
b = IsLeapYear2(i)
Next i, j
t2 = Timer()
Debug.Print 2, (t2 - t1) * 1000
End Sub
Public Function ISLeapYear(Y As Integer) AS Boolean
' Uses a 2 or 4 digit year
'To determine whether a year is a leap year, follow these steps:
'1 If the year is evenly divisible by 4, go to step 2. Otherwise, go to step 5.
'2 If the year is evenly divisible by 100, go to step 3. Otherwise, go to step 4.
'3 If the year is evenly divisible by 400, go to step 4. Otherwise, go to step 5.
'4 The year is a leap year (it has 366 days).
'5 The year is not a leap year (it has 365 days).
If Y Mod 4 = 0 Then ' This is Step 1 either goto step 2 else step 5
If Y Mod 100 = 0 Then ' This is Step 2 either goto step 3 else step 4
If Y Mod 400 = 0 Then ' This is Step 3 either goto step 4 else step 5
ISLeapYear = True ' This is Step 4 from step 3
Exit Function
Else: ISLeapYear = False ' This is Step 5 from step 3
Exit Function
End If
Else: ISLeapYear = True ' This is Step 4 from Step 2
Exit Function
End If
Else: ISLeapYear = False ' This is Step 5 from Step 1
End If
End Function
Public Function isLeapYear(Optional intYear As Variant) As Boolean
If IsMissing(intYear) Then
intYear = Year(Date)
End If
If intYear Mod 400 = 0 Then
isLeapYear = True
ElseIf intYear Mod 4 = 0 And intYear Mod 100 <> 0 Then
isLeapYear = True
End If
End Function
I see many great concepts that indicate extra understanding
and usage of date functions that are terrific to learn from...
In terms of code efficiency..
consider the machine code needed for a function to execute
rather than complex date functions
use only fairly fast integer functions
BASIC was built on GOTO
I suspect that something like below is faster
Function IsYLeapYear(Y%) As Boolean
If Y Mod 4 <> 0 Then GoTo NoLY ' get rid of 75% of them
If Y Mod 400 <> 0 And Y Mod 100 = 0 Then GoTo NoLY
IsYLeapYear = True
NoLY:
End Function
Here's another simple option.
Leap_Day_Check = Day(DateValue("01/03/" & Required_Year) - 1)
If Leap_Day_Check = 28 then it is not a leap year, if it is 29 it is.
VBA knows what the date before 1st March is in a year and so will set it to be either 28 or 29 February for us.