I am newish to MS Access.
I require the equivalent formula from excel to mc access which will workout -1 day from my data-set less weekends/public holidays.
So this is what i use in excel atm: =WORKDAY(start date,days,[holidays])
Any help would be greatly appreciated.
There is no native function, but you can use this set of functions:
Option Explicit
' Common constants.
' Date.
Public Const DaysPerWeek As Long = 7
Public Const MaxDateValue As Date = #12/31/9999#
Public Const MinDateValue As Date = #1/1/100#
' Workdays per week.
Public Const WorkDaysPerWeek As Long = 5
' Average count of holidays per week maximum.
Public Const HolidaysPerWeek As Long = 1
' Adds Number of full workdays to Date1 and returns the found date.
' Number can be positive, zero, or negative.
' Optionally, if WorkOnHolidays is True, holidays are counted as workdays.
'
' For excessive parameters that would return dates outside the range
' of Date, either 100-01-01 or 9999-12-31 is returned.
'
' Will add 500 workdays in about 0.01 second.
'
' Requires table Holiday with list of holidays.
'
' 2015-12-19. Gustav Brock. Cactus Data ApS, CPH.
'
Public Function DateAddWorkdays( _
ByVal Number As Long, _
ByVal Date1 As Date, _
Optional ByVal WorkOnHolidays As Boolean) _
As Date
Const Interval As String = "d"
Dim Holidays() As Date
Dim Days As Long
Dim DayDiff As Long
Dim MaxDayDiff As Long
Dim Sign As Long
Dim Date2 As Date
Dim NextDate As Date
Dim DateLimit As Date
Dim HolidayId As Long
Sign = Sgn(Number)
NextDate = Date1
If Sign <> 0 Then
If WorkOnHolidays = True Then
' Holidays are workdays.
Else
' Retrieve array with holidays between Date1 and Date1 + MaxDayDiff.
' Calculate the maximum calendar days per workweek.
MaxDayDiff = Number * DaysPerWeek / (WorkDaysPerWeek - HolidaysPerWeek)
' Add one week to cover cases where a week contains multiple holidays.
MaxDayDiff = MaxDayDiff + Sgn(MaxDayDiff) * DaysPerWeek
If Sign > 0 Then
If DateDiff(Interval, Date1, MaxDateValue) < MaxDayDiff Then
MaxDayDiff = DateDiff(Interval, Date1, MaxDateValue)
End If
Else
If DateDiff(Interval, Date1, MinDateValue) > MaxDayDiff Then
MaxDayDiff = DateDiff(Interval, Date1, MinDateValue)
End If
End If
Date2 = DateAdd(Interval, MaxDayDiff, Date1)
' Retrive array with holidays.
Holidays = GetHolidays(Date1, Date2)
End If
Do Until Days = Number
If Sign = 1 Then
DateLimit = MaxDateValue
Else
DateLimit = MinDateValue
End If
If DateDiff(Interval, DateAdd(Interval, DayDiff, Date1), DateLimit) = 0 Then
' Limit of date range has been reached.
Exit Do
End If
DayDiff = DayDiff + Sign
NextDate = DateAdd(Interval, DayDiff, Date1)
Select Case Weekday(NextDate)
Case vbSaturday, vbSunday
' Skip weekend.
Case Else
' Check for holidays to skip.
' Ignore error when using LBound and UBound on an unassigned array.
On Error Resume Next
For HolidayId = LBound(Holidays) To UBound(Holidays)
If Err.Number > 0 Then
' No holidays between Date1 and Date2.
ElseIf DateDiff(Interval, NextDate, Holidays(HolidayId)) = 0 Then
' This NextDate hits a holiday.
' Subtract one day before adding one after the loop.
Days = Days - Sign
Exit For
End If
Next
On Error GoTo 0
Days = Days + Sign
End Select
Loop
End If
DateAddWorkdays = NextDate
End Function
' Returns the holidays between Date1 and Date2.
' The holidays are returned as a recordset with the
' dates ordered ascending, optionally descending.
'
' Requires table Holiday with list of holidays.
'
' 2015-12-18. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function DatesHoliday( _
ByVal Date1 As Date, _
ByVal Date2 As Date, _
Optional ByVal ReverseOrder As Boolean) _
As DAO.Recordset
' The table that holds the holidays.
Const Table As String = "Holiday"
' The field of the table that holds the dates of the holidays.
Const Field As String = "Date"
Dim rs As DAO.Recordset
Dim SQL As String
Dim SqlDate1 As String
Dim SqlDate2 As String
Dim Order As String
SqlDate1 = Format(Date1, "\#yyyy\/mm\/dd\#")
SqlDate2 = Format(Date2, "\#yyyy\/mm\/dd\#")
ReverseOrder = ReverseOrder Xor (DateDiff("d", Date1, Date2) < 0)
Order = IIf(ReverseOrder, "Desc", "Asc")
SQL = "Select " & Field & " From " & Table & " " & _
"Where " & Field & " Between " & SqlDate1 & " And " & SqlDate2 & " " & _
"Order By 1 " & Order
Set rs = CurrentDb.OpenRecordset(SQL, dbOpenSnapshot)
Set DatesHoliday = rs
End Function
' Returns the holidays between Date1 and Date2.
' The holidays are returned as an array with the
' dates ordered ascending, optionally descending.
'
' The array is declared static to speed up
' repeated calls with identical date parameters.
'
' Requires table Holiday with list of holidays.
'
' 2015-12-18. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function GetHolidays( _
ByVal Date1 As Date, _
ByVal Date2 As Date, _
Optional ByVal OrderDesc As Boolean) _
As Date()
' Constants for the arrays.
Const DimRecordCount As Long = 2
Const DimFieldOne As Long = 0
Static Date1Last As Date
Static Date2Last As Date
Static OrderLast As Boolean
Static DayRows As Variant
Static Days As Long
Dim rs As DAO.Recordset
' Cannot be declared Static.
Dim Holidays() As Date
If DateDiff("d", Date1, Date1Last) <> 0 Or _
DateDiff("d", Date2, Date2Last) <> 0 Or _
OrderDesc <> OrderLast Then
' Retrieve new range of holidays.
Set rs = DatesHoliday(Date1, Date2, OrderDesc)
' Save the current set of date parameters.
Date1Last = Date1
Date2Last = Date2
OrderLast = OrderDesc
Days = rs.RecordCount
If Days > 0 Then
' As repeated calls may happen, do a movefirst.
rs.MoveFirst
DayRows = rs.GetRows(Days)
' rs is now positioned at the last record.
End If
rs.Close
End If
If Days = 0 Then
' Leave Holidays() as an unassigned array.
Erase Holidays
Else
' Fill array to return.
ReDim Holidays(Days - 1)
For Days = LBound(DayRows, DimRecordCount) To UBound(DayRows, DimRecordCount)
Holidays(Days) = DayRows(DimFieldOne, Days)
Next
End If
Set rs = Nothing
GetHolidays = Holidays()
End Function
Related
I have a series of dates, which are recorded in both BST and GMT (depending upon the time of year). I want them to all be in GMT but I can't work out how to get Access to return the last Sunday in March (when we switch from GMT to BST) and the last Sunday in October (when we switch back).
All help appreciated!
I'm working in Access 2010.
Thank you in advance.
You can use this generic function:
' Calculates the date of the occurrence of Weekday in the month of DateInMonth.
'
' If Occurrence is 0 or negative, the first occurrence of Weekday in the month is assumed.
' If Occurrence is 5 or larger, the last occurrence of Weekday in the month is assumed.
'
' If Weekday is invalid or not specified, the weekday of DateInMonth is used.
'
' 2016-06-09. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function DateWeekdayInMonth( _
ByVal DateInMonth As Date, _
Optional ByVal Occurrence As Integer, _
Optional ByVal Weekday As VbDayOfWeek = -1) _
As Date
Const DaysInWeek As Integer = 7
Dim Offset As Integer
Dim Month As Integer
Dim Year As Integer
Dim ResultDate As Date
' Validate Weekday.
Select Case Weekday
Case _
vbMonday, _
vbTuesday, _
vbWednesday, _
vbThursday, _
vbFriday, _
vbSaturday, _
vbSunday
Case Else
' Zero, none or invalid value for VbDayOfWeek.
Weekday = VBA.Weekday(DateInMonth)
End Select
' Validate Occurence.
If Occurrence <= 0 Then
Occurrence = 1
ElseIf Occurrence > 5 Then
Occurrence = 5
End If
' Start date.
Month = VBA.Month(DateInMonth)
Year = VBA.Year(DateInMonth)
ResultDate = DateSerial(Year, Month, 1)
' Find offset of Weekday from first day of month.
Offset = DaysInWeek * (Occurrence - 1) + (Weekday - VBA.Weekday(ResultDate) + DaysInWeek) Mod DaysInWeek
' Calculate result date.
ResultDate = DateAdd("d", Offset, ResultDate)
If Occurrence = 5 Then
' The latest occurrency of Weekday is requested.
' Check if there really is a fifth occurrence of Weekday in this month.
If VBA.Month(ResultDate) <> Month Then
' There are only four occurrencies of Weekday in this month.
' Return the fourth as the latest.
ResultDate = DateAdd("d", -DaysInWeek, ResultDate)
End If
End If
DateWeekdayInMonth = ResultDate
End Function
Then:
LastSundayMarch = DateWeekdayInMonth(DateSerial(Year(SomeDateOfYear), 3, 1), 5, vbSunday)
LastSundayOctober = DateWeekdayInMonth(DateSerial(Year(SomeDateOfYear), 10, 1), 5, vbSunday)
or as functions:
Public Function DateLastSundayMarch(ByVal DateOfYear As Date) As Date
DateLastSundayMarch = DateWeekdayInMonth(DateSerial(Year(DateOfYear), 3, 1), 5, vbSunday)
End Function
Public Function DateLastSundayOctober(ByVal DateOfYear As Date) As Date
DateLastSundayOctober = DateWeekdayInMonth(DateSerial(Year(DateOfYear), 10, 1), 5, vbSunday)
End Function
Now you can have expressions like:
=DateLastSundayOctober([SomeDateField])
to be used as ControlSource for a control or in the GUI query designer.
This will work:
Option Explicit
Function getLastSundayOfMarchOfThisYear() As Date
getLastSundayOfMarchOfThisYear = getLastSundayOfMonthOfThisYear(3)
End Function
Function getLastSundayOfOctoberOfThisYear() As Date
getLastSundayOfOctoberOfThisYear = getLastSundayOfMonthOfThisYear(10)
End Function
Private Function getLastSundayOfMonthOfThisYear(month As Long) As Date
Debug.Assert month >= 1 And month <= 12
Dim i As Long, _
tmpDate As Date, _
daysInMonth As Long
daysInMonth = Day(DateSerial(year(Date), month + 1, 1) - 1)
For i = daysInMonth To 1 Step -1
tmpDate = CDate(year(Date) & "-" & month & "-" & i)
If Weekday(tmpDate) = vbSunday Then
getLastSundayOfMonthOfThisYear = tmpDate
Exit Function
End If
Next
End Function
Does anyone know if there's an actual equivalent method in VB6 for .NET's DateTime.ParseExact() method? I've tried using DateSerial(), IsDate() and CDate(), but, due to all of VB6's "helpfulness", I'm coming up with some unexpected results.
To be more specific, I'm trying to parse a text string from user input to validate whether or not it's an actual date. As an example, I'll be using the date 8/25/16. The usual expected input may or may not have delimiters between the month, day and year, so it may be entered as 82516.
Here's a sample of the code that's not working as intended (the value of 82516 is stored in the TempStr variable):
If IsDate(Format(TempStr, "#/##/##")) And IsDate(Format(TempStr, "##/#/##")) Then
TempDate = #12:00:00 AM#
ElseIf IsDate(Format(TempStr, "#/##/##")) Then
TempDate = CDate(Format(Tempstr, "#/##/##"))
ElseIf IsDate(Format(TempStr, "##/#/##")) Then
TempDate = CDate(Format(TempStr, "##/#/##"))
End If
Using the stated value, the first condition triggers. Knowing how it works, I understand why it's happening (it's "rearranging" the month, day and year to try to match a valid date), but I'm really trying to get it to parse the date in a specific order. I know that .NET's DateTime.ParseExact() method would get me there, but I have to do this in VB6 (maintaining some legacy code).
I tried using DateSerial():
If DateSerial(CInt(Right(TempStr, 2)), CInt(Left(TempStr, 1)), CInt(Mid(TempStr, 2, 2))) > #12:00:00 AM# Then
If DateSerial(CInt(Right(TempStr, 2)), CInt(Left(TempStr, 2)), CInt(Mid(TempStr, 3, 1))) > #12:00:00 AM# Then
TempDate = #12:00:00 AM#
Else
TempDate = DateSerial(CInt(Right(TempStr, 2)), CInt(Left(TempStr, 1)), CInt(Mid(TempStr, 2, 2)))
End If
Else
If DateSerial(CInt(Right(TempStr, 2)), CInt(Left(TempStr, 2)), CInt(Mid(TempStr, 3, 1))) > #12:00:00 AM# Then
TempDate = DateSerial(CInt(Right(TempStr, 2)), CInt(Left(TempStr, 2)), CInt(Mid(TempStr, 3, 1)))
Else
TempDate = #12:00:00 AM#
End If
End If
But that also comes along with an automatic correction if the values for any of the parameters fall outside of the acceptable ranges.
I also tried the following variation of the above code:
If IsDate(Format(TempStr, "m/dd/yy")) And IsDate(Format(TempStr, "mm/d/yy")) Then
...
But the first test results in an entirely different value of 3/12/26, which is WAY off from the original input.
Is there any way to accurately emulate the .NET DateTime.ParseExact() method in VB6, or am I just going to have to toss these types of user input values out as invalid/ambiguous?
I will personally write a function for ensuring the correct date is returned -
First get the string/integer, break it down into chunks and add values to those chunks and return a combined date...
Option Explicit
Public Function MakeCorrectDate()
Dim xMakeDate As Long, xDay As Integer, xMonth As Integer, xYear As Integer, xCentury As Integer, strCorrectDate As String
''xMake as long because of size, strCorrectDate as string to allow the /...
xMakeDate = txtInput.Text
''Assuming the format will ALWAYS be the same days, months and year (12/20/16) and length is ALWAYS 6...
xDay = Left$(xMakeDate, 2)
xMonth = Mid$(xMakeDate, 3, 2)
xYear = Right(xMakeDate, 2)
''First get the correct part to 1900 or 2000...
If xYear = "00" Then
xCentury = 20
ElseIf xYear < 99 And xYear > 20 Then ''Year 2000 and year 2020
xCentury = 19
Else
xCentury = 20
End If
strCorrectDate = xDay & "/" & xMonth & "/" & xCentury & xYear
txtYear.Text = strCorrectDate
End Function
Private Sub cmdGetCorrectDate_Click()
If Not Len(txtInput.Text) = 6 Then
MsgBox "Incorrect information, must be 6 or more characters."
Exit Sub
Else
Call MakeCorrectDate
End If
End Sub
Private Sub txtInput_Change()
''Ensure the user adds only numerical text...
Dim WshShell As Object
Set WshShell = CreateObject("WScript.Shell")
If Not IsNumeric(txtInput.Text) Then
WshShell.SendKeys "{BackSpace}"
End If
End Sub
Okay, so here's what I've come up with as a solution for my current needs. Similar to what #Andre-Oosthuizen posted above, I've decided to drastically simplify the validation from what I was doing before. This series of functions requires the user to enter a six-digit date (two-digit month, two-digit day, and two-digit year). I don't believe the century is going to be a factor in this specific application, so I'm going to leave that test out.
This should be acceptable to our users as they've had similar restrictions in other systems. While I'd personally prefer a more "bullet-proof" solution (such as using a DatePicker or other manipulation of the UI), I think this is going to be the most effective for our environment.
'----------------------------------------------------------------------
' LostFocus event handler for the txtEffectiveDate TextBox.
' Test for a valid date when the user attempts to leave the field.
'----------------------------------------------------------------------
Private Sub txtEffectiveDate_LostFocus()
' *********************************************************************
' ** Don't have the event handler try to do any parsing. Just pass **
' ** the .Text value to the validation function. If a date comes **
' ** back, reformat it to "look" like a date and move on. Otherwise **
' ** pop up an "error" message and return focus to the TextBox for **
' ** the user to correct their input. **
' *********************************************************************
Dim TempDate As Date
TempDate = CheckForValidDate(Me.txtEffectiveDate.Text)
If TempDate > #12:00:00 AM# Then
' If a valid Date is returned, put the formatted String value
' into the TextBox and move on.
Me.txtEffectiveDate.Text = Format(TempDate, "mm/dd/yy")
Else
' If the Date value is not valid (#12:00:00 AM#), notify the
' user and refocus on the TextBox to force the user to
' correct the input before continuing.
MsgBox "The date you entered was not valid." & vbCrLf & vbCrLf & _
"Please enter two digits for the month, two digits for the day and" & vbCrLf & _
"two digits for the year." & vbCrLf & vbCrLf & _
"For example, today's date should be entered as either " & Format(Now, "mmddyy") & vbCrLf & _
" or " & Format(Now, "mm/dd/yy") & ".", _
vbOKOnly + vbExclamation, "INVALID INPUT FORMAT"
Me.txtEffectiveDate.SetFocus
Me.txtEffectiveDate.SelStart = 0
Me.txtEffectiveDate.SelLength = Len(Me.txtEffectiveDate.Text)
End If
End Sub
'----------------------------------------------------------------------
' Attempts to convert the String input to a Date value. If the String
' value is already a Date (i.e., "1/1/16" or similar), go ahead and
' assume that the user wants that date and return it as a Date value.
' Otherwise, strip any non-numeric characters and break apart the input
' to pass along for further validation.
'----------------------------------------------------------------------
Private Function CheckForValidDate(ByVal DateStr As String) As Date
Dim TempDate As Date
If IsDate(DateStr) Then
' If the String value is already in a date format,
' just return the Date value of the String.
TempDate = CDate(DateStr)
Else
Dim TempStr As String
Dim CurrentChar As String
Dim TempYear As Integer
Dim TempMonth As Integer
Dim TempDay As Integer
Dim I As Integer
' Strip all non-numeric characters to get a purely numeric string.
For I = 1 To Len(DateStr)
CurrentChar = Mid(DateStr, I, 1)
If IsNumeric(CurrentChar) Then
TempStr = TempStr & CurrentChar
End If
Next I
' The all-numeric string should be exactly six characters
' (for this application).
If Len(Trim(TempStr)) = 6 Then
Dim NewDateStr As String
' Break the numeric string into the component parts -
' Month, Day, and Year. At six characters, there should
' be two characters for each element.
TempMonth = CInt(Left(TempStr, 2))
TempDay = CInt(Mid(TempStr, 3, 2))
TempYear = CInt(Right(TempStr, 2))
' Now pass the individual values to the second part of
' the validation to ensure each of the individual values
' falls within acceptable ranges.
NewDateStr = GetValidDateString(TempMonth, TempDay, TempYear)
' If the returned String value is not empty, then convert
' it to a Date value for returning to the calling method
If Len(Trim(NewDateStr)) > 0 Then
TempDate = CDate(NewDateStr)
End If
End If
End If
CheckForValidDate = TempDate
End Function
'----------------------------------------------------------------------
' Using numeric values for Month, Day, and Year, attempt to build a
' valid Date in mm/dd/yy format.
'----------------------------------------------------------------------
Private Function GetValidDateString(ByVal intMonth As Integer, ByVal intDay As Integer, ByVal intYear As Integer) As String
Dim ReturnStr As String
ReturnStr = ""
If intMonth >= 1 And intMonth <= 12 Then
Select Case intMonth
Case 1, 3, 5, 7, 8, 10, 12
' January, March, May, July, August, October and December
' have 31 days.
If intDay >= 1 And intDay <= 31 Then
ReturnStr = intMonth & "/" & intDay & "/" & intYear
End If
Case 4, 6, 9, 11
' April, June, September and November
' have 30 days
If intDay >= 1 And intDay <= 30 Then
ReturnStr = intMonth & "/" & intDay & "/" & intYear
End If
Case 2
' Depending on whether it is a Leap Year (every four years),
' February may have 28 or 29 days.
If intYear Mod 4 = 0 Then
If intDay >= 1 And intDay <= 29 Then
ReturnStr = intMonth & "/" & intDay & "/" & intYear
End If
Else
If intDay >= 1 And intDay <= 28 Then
ReturnStr = intMonth & "/" & intDay & "/" & intYear
End If
End If
End Select
End If
' Return the recombined string to the calling function.
GetValidDateString = ReturnStr
End Function
There's still obviously going to be some room for error, but I believe this will solve the issue for now. It's not perfect, but hopefully we'll be able to move away from this VB6 system soon. Thank you for all of the ideas and suggestions. They were very helpful in narrowing down the best solution for this specific implementation.
Closed. This question needs debugging details. It is not currently accepting answers.
Edit the question to include desired behavior, a specific problem or error, and the shortest code necessary to reproduce the problem. This will help others answer the question.
Closed 8 years ago.
Improve this question
UPDATE I have turned Option Strict ON as suggested in the comments and fixed the errors, however the VAT is still not calculating correctly, here is a GIST link to the full function
I have a problem with the VAT rate not calculating correctly,
the MOT line should always be set at 0% and the BOMOT line should set based on the customers VAT code (this customer has the standard 20% VAT code and as you can see it is set correctly
when i change the customer to my 0 rated VAT customer the code again calculates correctly,
now when i change the customer back from this to a Standard VAT customer it recalculates incorrect and changes the MOT line to 20% when it should be zero
Here is the code that calculates the VAT
Dim FPVATCode As String = 1
Dim FPVATRate As Decimal = 0
If c.LoadCode("V", FPVATCode, "") Then
FPVATRate = Val(c.Rec!a2)
End If
If customerVATRate <> -1 Then
If customerVATRate < FPVATRate Then
line.VCode = customerVATCode
Else
line.VCode = FPVATCode
End If
Else
line.VCode = FPVATCode
End If
THE FULL FUNCTION Link to full function
Public Sub RecalculateDocumentPrices(ByVal NewCust As String) 'V749910 (163.18)
Dim newCustomer As New customer
newCustomer.LoadNewCustomer(NewCust)
' Get the customer VAT rate
Dim customerVATCode As String = newCustomer.GetVCode
Dim customerVATRate As Decimal = -1
Dim bAutoPartLinked As Boolean = Settings.AutoPartLinked
Dim c As New Codes
If c.LoadCode("V", customerVATCode, "") Then
customerVATRate = Val(c.Rec!a2)
End If
'L762946 (163.34) - only attempt recalculation if there are some lines on the document
If Not lines Is Nothing Then
For Each line As Line In lines
line.disc = 0
Select Case line.LineType
Case line.lineTypes.P, line.lineTypes.LT, line.lineTypes.SS, line.lineTypes.TA
'for a regular (ie. Non Branch Stock) product, get the price
If line.DescKey2 Is Nothing OrElse line.DescKey2.ToLower <> "branch" Then
''get the product price
Dim p As New Product
If p.LoadProduct(line.Part, , newCustomer.Rec!Cdisc, NewCust) Then 'V772656 (163.65) - pass the selling level of the new customer
'V749910 (163.19) - use the lower of the customer & product VAT rates
Dim productVATCode As String = p.Rec!Vcode
Dim productVATRate As Decimal = 0
If c.LoadCode("V", productVATCode, "") Then
productVATRate = Val(c.Rec!a2)
End If
If customerVATRate <> -1 Then
If customerVATRate < productVATRate Then
line.VCode = customerVATCode
Else
line.VCode = p.Rec!vcode
End If
Else
line.VCode = p.Rec!vcode
End If
'Remove VatIncCheck - V838410 (1.0.164.5)
'set the VatInclusive price if appropriate
'If newCustomer.IsVATInclusiveCustomer Then
' 'For a non linked system, add the VAT to the price
' Dim sellPrice As Decimal = p.sMSell
' If Not Settings.AutoPartLinked Then
' sellPrice *= Math.Round((1 + (line.vatRate / 100)), 2, MidpointRounding.AwayFromZero)
' End If
' line.IsVATInclusivePrice = True
' line.VatInclusivePrice = sellPrice
'Else
'V772656 (163.65) - was setting the unit price THEN the VAT Inc price THEN setting IsVatInclusivePrice to false. Therefore
'the unit price was being overwritten.
line.IsVATInclusivePrice = False
line.VatInclusivePrice = 0
If bAutoPartLinked Then 'L811755 (1.0.163.105)
line.unit = p.sMSell
End If
'End If
'Apply markon
CalcMarkon(line)
End If
Else
'for a Branch Stock product, perform a supplier enquiry to obtain the price
Dim awdTmp As New AutoworkDocument
Dim l As New Line
l.Part = line.Part
awdTmp.LookupLine(l)
'V749910 (163.19) - use the lower of the customer & product VAT rates
Dim productVATCode As Integer = 1
Dim productVATRate As Decimal = 0
If c.LoadCode("V", productVATCode, "") Then
productVATRate = Val(c.Rec!a2)
End If
If customerVATRate <> -1 Then
If customerVATRate < productVATRate Then
line.VCode = customerVATCode
Else
line.VCode = productVATCode
End If
Else
line.VCode = productVATCode
End If
'set the VatInclusive price if appropriate
If newCustomer.IsVATInclusiveCustomer Then
'Branch stock not available to Linked mode so just apply the vat
line.IsVATInclusivePrice = True
line.VatInclusivePrice = Math.Round(l.unit * (1 + (line.vatRate / 100)), 2, MidpointRounding.AwayFromZero)
Else
'V772656 (163.65) - was setting the unit price THEN the VAT Inc price THEN setting IsVatInclusivePrice to false. Therefore
'the unit price was being overwritten.
line.IsVATInclusivePrice = False
line.VatInclusivePrice = 0
line.unit = l.unit
End If
'Apply markon
CalcMarkon(line)
End If
Case line.lineTypes.FPP 'L829840 (1.0.163.123)
Case line.lineTypes.L 'V831093 (1.0.163.123)
'set the VatInclusive price if appropriate
If newCustomer.IsVATInclusiveCustomer Then 'V831093 (1.0.163.125)
'Branch stock not available to Linked mode so just apply the vat
line.IsVATInclusivePrice = True
line.VatInclusivePrice = Math.Round(line.unit * (1 + (line.vatRate / 100)), 2, MidpointRounding.AwayFromZero)
Else
'V772656 (163.65) - was setting the unit price THEN the VAT Inc price THEN setting IsVatInclusivePrice to false. Therefore
'the unit price was being overwritten.
line.IsVATInclusivePrice = False
line.VatInclusivePrice = 0
line.unit = line.unit
End If
Case line.lineTypes.FP
'get the selling price of the fixed price job
Dim cj As New CustomJobs
Dim ds As DataSet
Dim dv As DataView
ds = cj.LoadCustomJob(line.Part)
dv = ds.Tables("CustomJob").DefaultView
Dim dvHead As DataView = ds.Tables("JobHeader").DefaultView
If dvHead.Table.Rows.Count > 0 Then ''00518984 (1.0.163.105)
line.cost = CType(dvHead.Table.Rows(0)("FpCost"), Decimal)
'V749910 (163.19) - use the lower of the customer & product VAT rates
'V749910 (163.18) - If a VATInclusive line, set the VATInclusive price
If newCustomer.IsVATInclusiveCustomer Then
line.IsVATInclusivePrice = True
line.VatInclusivePrice = Math.Round(dvHead.Table.Rows(0)("FpSell") * (1 + (line.vatRate / 100)), 2, MidpointRounding.AwayFromZero)
Else
'V772656 (163.65) - was setting the unit price THEN the VAT Inc price THEN setting IsVatInclusivePrice to false. Therefore
'the unit price was being overwritten.
line.IsVATInclusivePrice = False
line.VatInclusivePrice = 0
line.unit = CType(dvHead.Table.Rows(0)("FpSell"), Decimal)
End If
End If ''00518984 END
Dim FPVATCode As String = CType(1, String)
Dim FPVATRate As Decimal = 0
If c.LoadCode("V", FPVATCode, "") Then
FPVATRate = CType(Val(c.Rec!a2), Decimal)
End If
If customerVATRate <> -1 Then
If customerVATRate < FPVATRate Then
line.VCode = CType(customerVATCode, Short)
Else
line.VCode = CType(FPVATCode, Short)
End If
Else
line.VCode = CType(FPVATCode, Short)
End If
Case line.lineTypes.CON
'just set the ISVatInclusive flag on this line. The consumables amount is calculated once all lines have been processed by the SaveSess().
line.VCode = customerVATCode
line.IsVATInclusivePrice = newCustomer.IsVATInclusiveCustomer
End Select
Next
End If
End Sub
Now resolved, VAT was being calculated from products in the wrong table,
inserted this conditional in the method and it fixed it,
'00518984 Calculates VAT for items in the labour table
Dim lB As New Product
Dim dv1 As DataView = lB.LabourSearch(line.Part)
If dv1.Table.Rows.Count > 0 Then
Dim dr1 As DataRow = dv1.ToTable.Rows(0)
Dim PVCode As Integer = dr1("VCode")
Beep()
line.VCode = PVCode
Else
Dim FPVATCode As String = CType(1, String)
Dim FPVATRate As Decimal = 0
If c.LoadCode("V", FPVATCode, "") Then
FPVATRate = CType(Val(c.Rec!a2), Decimal)
End If
line.VCode = customerVATCode
End If
'00518984 END
Sorry again, experts for the bother again.but
We have a db date called orderdate.
If today's date - orderdate is less than 2 days (or 48 hours), disable Cancel Order button so user cannot cancel his or her order.
When I tried running the following code, I get Input string not in the format
Orderdate is of type datetime. However, we would like to display the date in the format of MM/dd/yyyy. Example: 6/4/2013, not 06/04/2013.
Can you please look at my code and tell me what I am doing wrong?
If dr1.Read() Then
Dim odate As String = DateTime.Parse(dr1("orderDates").ToString()).ToShortDateString()
Dim cancelBtn As New Button()
Dim dates As String = DateTime.Parse(Now().ToString()).ToShortDateString()
If (sdate - dates) <2 Then
cancelBtn.Enabled = False
Else
cancelBtn.Enabled = True
End If
End If
Protected Sub GridView1_RowDataBound(ByVal sender As Object, ByVal e As GridViewRowEventArgs)
' Create cancel training button
Dim cancelBtn As New Button()
cancelBtn.Style.Add("width", "105px")
cancelBtn.Style.Add("padding", "5px")
cancelBtn.Style.Add("margin", "5px")
'cancelBtn.Enabled = False
cancelBtn.Text = "Cancel training"
If e.Row.RowIndex > "-1" Then
' Change tracking ID to link
'Dim track As [String] = e.Row.Cells(4).Text
'If track <> " " AndAlso track.Length > 0 Then
' Dim trackLink As New Literal()
' trackLink.Text = "<a style='color: blue;' href='" + track + "'/>Track</a>"
' e.Row.Cells(4).Controls.Add(trackLink)
'End If
' Add buttons to column
Dim oid As [String] = e.Row.Cells(0).Text
Dim invoiceLink As New Literal()
invoiceLink.Text = "<a style='color: blue;' href='Invoice.aspx?oid=" + oid + "'/>" + oid + "</a>"
e.Row.Cells(0).Controls.Add(invoiceLink)
e.Row.Cells(e.Row.Cells.Count - 1).Controls.Add(cancelBtn)
' Pass order id & row to on-click event
'cancelBtn.Click += new EventHandler(this.cancelBtn_Click);
'cancelBtn.CommandArgument = e.Row.RowIndex + "-" + oid
End If
End Sub
I'm not sure why you'd want to convert your date fields into strings. I would recommend leaving those as datetime objects for your comparison. You can always manipulate the display of the dates in your presentation logic.
This is some working code leaving as dates using Subtract and TotalDays:
Dim cancelBtn As New Button()
Dim odate As DateTime = DateTime.Parse(dr1("orderDates").ToString())
Dim dates As DateTime = DateTime.Now()
If dates.Subtract(odate).TotalDays >= 2 Then
cancelBtn.Enabled = False
Else
cancelBtn.Enabled = True
End If
You could also consolidate the If statement to a single line:
cancelBtn.Enabled = dates.Subtract(odate).TotalDays < 2
EDIT: Regarding the logic, your DB field orderDates sounds like it refers to the day the order was created. That date will always be in the past, so we would be interested in Today - orderDates.
However, based on your comments it seems orderDates refers to the day the order will ship. That date must be more than 2 days in the future for the user to cancel his order, so we're interested in orderDates - Today.
I don't see where you run the order date logic inside GridView1_RowDataBound.
Private Function MoreThanTwoDaysUntilShip() As Boolean
'logic to open dr1
If dr1.Read() Then
Dim shipDate As Date = DateTime.Parse(dr1("orderDates").ToString())
Dim today As Date = Date.Now
Return shipDate.Subtract(today).TotalDays > 2
End If
Return False
End Function
Protected Sub GridView1_RowDataBound(ByVal sender As Object, ByVal e As GridViewRowEventArgs)
' Create cancel training button
Dim cancelBtn As New Button()
cancelBtn.Style.Add("width", "105px")
cancelBtn.Style.Add("padding", "5px")
cancelBtn.Style.Add("margin", "5px")
'add this
cancelBtn.Enabled = MoreThanTwoDaysUntilShip()
'etc
End Sub
DateTime.Parse(Now().ToString()).ToShortDateString()
Replace with
Today
And otherwise, don't manipulate dates in strings.
I need to filter data based on a date range.
My table has a field Process date. I need to filter the records and display those in the range FromDate to ToDate.
How do I write a function in VB.NET which can help me filter the data.
Am I on the right track??
Why dont you do yourself a favor and DateTime.Parse your strings and use Date comparison operators
Something like
Function ObjectInRange(ByRef obj As Object, ByVal str1 As String, ByVal str2 As String) As Boolean
Dim date1 As DateTime = DateTime.Parse(str1)
Dim date2 As DateTime = DateTime.Parse(str2)
Dim inRange = False
For Each prop As PropertyInfo In obj.GetType().GetProperties()
Dim propVal = prop.GetValue(obj, Nothing)
If propVal Is Nothing Then
Continue For
End If
Dim propValString = Convert.ToString(propVal)
Dim propValDate = DateTime.Parse(propValString)
If propValDate.CompareTo(date1) > 0 And propValDate.CompareTo(date2) < 0 Then
inRange = True
Exit For
End If
Next
Return inRange
End Function