I have to make a report that will execute automatically several times, every day, with different settings. The report selects records between two dates. Now, the client wants to be free to define, in a text or excel file, the dates that will run each report. For example, every day I want to run the report for that day, and for that same day the previous year, and for the same day the previous week, and for the previous week, and for the next month of the previous year. Then on the first of every month, the whole previous month, etc. I think you get the gist.
My question is: Is there any established way of doing this? Some text encoding for offsets of dates? I've looked and nothing appears. However, it doesn't seem an outlandish proposition. I suppose the situation has happened before. I wouldn't like to reinvent the wheel. If, however, there is nothing, any idea would be welcome :-)
OK, so I did it myself, no free lunch this time :-) The format I chose is a string like:
+1W,fW,-1D (That would be the next week, first day of that week, then one day before that)
Separator is comma, keys are D for day, W for week, M for month, Y for year, F for first, L for Last (all keys can be lower or upper case). The format ignores whitespace, but the last non-whitespace character must be a key. Only integer offsets allowed.
I give my first implementation of a VBA function that interprets a text offset. It seems to work, although little testing done yet.
Well, that's all, for posterity.
Public Function GetDateFromOffset(fecIni As Date, sDif As String) As Date
Dim sArr() As String, ii As Integer, fRes As Date
fRes = fecIni
sArr = Split(sDif, ",")
For ii = LBound(sArr()) To UBound(sArr())
fRes = ApplyOneOffset(fRes, sArr(ii))
Next ii
GetDateFromOffset = fRes
End Function
Public Function ApplyOneOffset(fecIni As Date, sDif As String) As Date
Const C_DAY As String = "D", C_WEEK As String = "W", C_MONTH As String = "M", C_YEAR As String = "Y"
Const C_FIRST As String = "F", C_LAST As String = "L"
Dim iDesp As Integer, sDesp As String, fRes As Date
sDesp = UCase(Right(sDif, 1))
sDif = Trim(UCase(Left(sDif, Len(sDif) - 1)))
Select Case sDesp
Case C_DAY
If (IsNumeric(sDif)) Then
fRes = DateAdd("d", CInt(sDif), fecIni)
End If
Case C_WEEK
If (sDif = C_FIRST) Then
fRes = dhFirstDayInWeek(fecIni)
ElseIf (sDif = C_LAST) Then
fRes = dhLastDayInWeek(fecIni)
ElseIf (IsNumeric(sDif)) Then
fRes = DateAdd("ww", CInt(sDif), fecIni)
End If
Case C_MONTH
If (sDif = C_FIRST) Then
fRes = dhFirstDayInMonth(fecIni)
ElseIf (sDif = C_LAST) Then
fRes = dhLastDayInMonth(fecIni)
ElseIf (IsNumeric(sDif)) Then
fRes = DateAdd("m", CInt(sDif), fecIni)
End If
Case C_YEAR
If (sDif = C_FIRST) Then
fRes = DateSerial(YEAR(fecIni), 1, 1)
ElseIf (sDif = C_LAST) Then
fRes = DateSerial(YEAR(fecIni), 31, 12)
ElseIf (IsNumeric(sDif)) Then
fRes = DateAdd("yyyy", CInt(sDif), fecIni)
End If
Case Else
fRes = fecIni
End Select
ApplyOneOffset = fRes
End Function
Related
I am trying to display a message based on a date range. If it falls between the BeginDate and EndDate then the date should be display and if the date falls on 10-09-2017 then another message should be displayed, otherwise then it should display the date. This seems to fail and go directly to the else statement. My eyes are not picking up the error. How can something get displayed between a date range in VBScript.
<%
Dim DateT
Dim BeginDate
Dim EndDate
BeginDate = Day("2017-05-26")
EndDate = Day("2017-11-04")
DateT = Day(Date)
If BeginDate >= DateT =< EndDate
THEN response.write(DateT)
ElseIF BeginDate = Day("2017-10-09")THEN
response.write(DateT)
Else
response.write(DateT)
End If
%>
I believe your syntax is incorrect and your logic is overcomplicated.
Not exactly sure of the syntax here or the correct date format but I added some response.write for you to check (which should have been your first stop)
Your logic is overcomplicated because the only time it doesn't display the date is when it matches that special date..
Dim DateT
Dim BeginDate
Dim EndDate
BeginDate = CDate("2017-05-26")
EndDate = CDate("2017-11-04")
DateT = Date()
' remove these when you're finished debugging
response.write(BeginDate)
response.write(EndDate)
If BeginDate = CDate("2017-10-09")THEN
response.write("Another message")
Else
response.write(DateT)
End If
I'm relatively new to VB6 and I've just been given an assignment where I have a date - for example '4/12/2016' - from this date, i'm trying to find out the day that it is. So let's say it's a wednesday. Now from this day, I'm trying to determine the dates for the week [sun(startdate) - sat(enddate)). How would I go about doing something like this?
EDIT: I have a pretty good idea about finding out the date for sunday and saturday, since I can simply do something along the lines...
dim dateStart,dateend as date
Ex of date given to me = '4/12/2016'
Dim dateDay as variant
dateDay = whatever I get here - i'm assuming that a date will return a number for whatever day it is ???? Not sure
Select Case dateDay
case 1 -Monday?
dateStart=dateadd("d",-1,'4/12/2016)
dateEnd = dateadd("d",6, '4/12/2016)
case 2 -Tuesday?
datestart = dateadd("d",-2,'4/12/2016)
dateend = dateadd("d",5,'4/12/2016)
End Select
Basically do the SELECT statement for all cases. Am I on the right track?
This code:
Debug.Print Format(DatePart("w", Now), "dddd")
will print whatever day of the week it is now to the Immediate window. If you want the abbreviated day of week, use "ddd" for the format.
Now, this code:
Dim DOW As String
Select Case DatePart("w", Now)
Case vbSunday
DOW = "Sunday"
Case vbMonday
DOW = "Monday"
Case vbTuesday
DOW = "Tuesday"
Case vbWednesday
DOW = "Wednesday"
Case vbThursday
DOW = "Thursday"
Case vbFriday
DOW = "Friday"
Case vbSaturday
DOW = "Saturday"
End Select
Debug.Print DOW
will do the same thing. However, it shows you how to evaluate programmatically which day of the week you're dealing with, by using vbSunday, vbMonday, etc. That should give you what you need to get started on your Select statement. To use your example, DatePart("w", "4/12/2016") evaluates to 3, or vbTuesday.
VB6 reference documentation is here, and rather well hidden I might add. Look up Format and DatePart to get familiar with other options.
EDIT: As MarkL points out, the Weekday function is available in VB6 (I thought it wasn't), and is simpler (one less argument) than using DatePart. This code:
Debug.Print Format(Weekday(Now), "dddd")
will also print whatever day of the week it is to the immediate window. jac has also provided a link to the Weekday function in the comments above.
You can try below codes, The code will return name of the day.
txtDateTime.Text = WeekdayName(Weekday(Now))
txtDateTime.Text = WeekdayName(Weekday(12 / 30 / 1995))
txtDateTime.Text = WeekdayName(Weekday(Date))
I need to know what date it is based on a week number and a day number.
So if I have weeknr=3 and day=1(for today- sunday) and lets say the year=2016 how can I make this into 2016-01-24.
Any input really appreciated, thanks.
Your best help will be the DatePart function (see here for docs). It's not altogether straightforward, because there are options to consider like "first day of week" and "first week of year", but you can define those in DatePart.
This would be my solution:
option explicit
function getDateByWeek(year, week, day)
dim dt, woy, add_days
dt = DateSerial(year, 1, 1)
do
woy = DatePart("ww", dt, vbSunday, vbFirstFullWeek)
' possibly change options [,firstdayofweek[,firstweekofyear]]
dt = DateAdd("d", 1, dt)
loop while woy<>1
add_days = week * 7 + day - 2
' -1 because we already added one day extra in the loop
' -1 to correct given day (sunday = 1)
getDateByWeek = DateAdd("d", add_days, dt)
end function
Response.Write "RESULT: " & getDateByWeek(2016, 3, 1) ' -> 24.01.2016
I start by finding the first day of the first week in a loop and then adding the cumulative amount of days to have a result.
Well the best way is to work out what the week start of the year is and take it from there.
Firstly, the first Thursday of any year is always in the first week of the year, so a simple calculation of adding the correct number onto the 1st January is obvious. After this we simply mulitply out the weeks and add the days:
Const C_THURSDAY = 5
Function GetDateFromYWD(y, w, d)
Dim tDate, aDate
'Get the first of the year...
tDate = DateSerial(y, 1, 1)
'Workout the start of the first week in the year...
aDate = tDate + Int(WeekDay(tDate)>C_THURSDAY And 7) - WeekDay(tDate)
'Add on the number of weeks plus days we're looking for...
aDate = aDate + (w * 7) + d
GetDateFromYWD = aDate
End Function
This question is somewhat exploratory as I decided to ask for advice/suggestions prior to attempting implementation in the hopes of a more timely path to the result. I have a database that stores intraday data for commodities and equities in 1 minute formats. The rationale behind this was that if I had 1 minute bars, I could create any time series bar that I wanted(i.e., 5 min , 15 min, 60 min etc,etc)
I thought about going the route where, for example, on a 15 minute chart I would simply iterate through the whole subset of results for a given symbol, look for rows with timestamps of :01,:16,:31:46 to begin capturing the open, close, maxhigh and minlow and cumulative volume and create new datapoint from that amalgamation. The problem with that is that, for commodities especially that trade 24 hours, there is not always a bar for every minute so there COULD be a situation where there isn't a :16 bar, or a :31 bar for a given symbol. This could foul the whole sequence of getting the bars data correctly. This also eliminated the possibility of just grabbing 15 bars at a time and capturing the open, close, maxhigh and minlow and cumulative volume. (Naturally, the table contains symbol, datetime, open,high,low,close,volume)
In order for either of the above to work I would have to "fix" the database every night by checking for missing bars and copying the prior bar to create a bar for that missing row. This is not the preferred method but Ill make it happen if necessary.
I am looking for any guidance on a proper path, whether from past experience or from reading about this problem here.
UPDATE:
Here is the code I've come up with that works BUT it is a little slow, it takes approximately 30 seconds to create 2 months of 30 minute bars from the 1 minute data in the database table.
Partial Class testintracharts
Inherits Page
<WebMethod>
Public Shared Function GetBars(ByVal symbol As String, ByVal seriesInterval As Integer) As List(Of ArrayList)
Dim barsList As New List(Of ArrayList)
'replace with TD model
Using ctx As New BATLEntities()
ctx.Configuration.AutoDetectChangesEnabled = False
'get all days for a given symbol, ordered from oldest to newest
Dim dateList As List(Of DateTime) = GetDistinctDates(ctx, symbol, seriesInterval).ToList()
'cache data series toa list for the given symbol
Dim seriesList As List(Of tsintrachart) = GetSymbolSeries(ctx, symbol)
If Not dateList Is Nothing And dateList.Any() Then
For Each seriesDate As DateTime In dateList
Dim curTime As TimeSpan = New TimeSpan(0, 1, 0)
Dim maxTime As TimeSpan = New TimeSpan(24, 0, 0)
'loop through the data series for the given day
'series start at 00:01:00
'series ends at 00:00:00 (next day)
While curTime < maxTime
Dim seriesMax As TimeSpan = curTime.Add(New TimeSpan(0, seriesInterval - 1, 0))
'get the data chunk based on series interval
'special condition when seriesmax reaches 24:00:00, in TimeSpan this becomes 1.00:00:00 (SQL doesn't like this)
'query needs to incorporate 00:00:00 of next day as the last entry for this time series
Dim data As List(Of tsintrachart) = Nothing
If TimeSpan.Compare(seriesMax, maxTime) = 0 Then
Dim nextSeriesDate As DateTime = seriesDate.AddDays(1)
data = GetDataSeries(seriesList, seriesDate, curTime, nextSeriesDate, New TimeSpan(0, 0, 0))
Else
data = GetDataSeries(seriesList, seriesDate, curTime, seriesDate, seriesMax)
End If
If Not data Is Nothing And data.Any() Then
Dim lastbarnum As Integer = data.Count - 1
Dim intradayDatum As New ArrayList()
With intradayDatum
.Add(DateTimeToUnixTimestamp(seriesDate.Add(seriesMax))) 'date
.Add(data(0).Open)
'.Add((From d In data Where TimeSpan.Compare(d.Time, curTime) = 0 Select d.Open).FirstOrDefault()) 'open
.Add((From d In data Select d.High).Max()) 'high
.Add((From d In data Select d.Low).Min()) 'low
.Add(data(lastbarnum).Close)
'.Add((From d In data Where TimeSpan.Compare(d.Time, seriesMax) = 0 Select d.Close).FirstOrDefault()) 'close or last sale
.Add((From d In data Select d.Volume).Sum()) 'volume
End With
barsList.Add(intradayDatum)
End If
'update current series start time, move to next series chunk
curTime = curTime.Add(New TimeSpan(0, seriesInterval, 0))
End While
Next
End If
End Using
Return barsList
End Function
Private Shared Function GetDataSeries(ByRef list As List(Of tsintrachart), ByVal startDate As DateTime, ByVal startSpan As TimeSpan, ByVal endDate As DateTime, ByVal endSpan As TimeSpan) As List(Of tsintrachart)
'LINQ, where symbol/time>=startRange/time<=endRange
Dim series = From data In list
Where (TimeSpan.Compare(data.Time, startSpan) >= 0 AndAlso data.Date = startDate) _
And (TimeSpan.Compare(data.Time, endSpan) <= 0 AndAlso data.Date = endDate)
Select data
Return series.ToList()
End Function
Private Shared Function GetSymbolSeries(ByRef ctx As BATLEntities, ByVal symbol As String) As List(Of tsintrachart)
Dim series = From data In ctx.tsintracharts
Where (data.Symbol = symbol)
Select data
Return series.ToList()
End Function
Private Shared Function GetDistinctDates(ByRef ctx As BATLEntities, ByVal symbol As String, ByVal interval As Integer) As IQueryable(Of DateTime)
Dim numDates As Integer = TakeValue(interval)
Dim dates = (From data In ctx.tsintracharts
Where data.Symbol = symbol
Select data.Date
Order By [Date]).Distinct().Take(numDates)
Return dates
End Function
Private Shared Function TakeValue(ByVal interval As Integer) As Integer
Select Case interval
Case 0 To 15
Return 1440
Case 16 To 30
Return 720
Case 31 To 60
Return 528
Case Else
Return 400
End Select
End Function
End Class
You could create a table that holds all possible 1min points in time. Then you can OUTER JOIN to that table to make the server fill in any gaps. The table would be like this:
CREATE TABLE TimePoints (
DateTime DATETIME2(0) PRIMARY KEY
)
And you have to fill it will a few decades of data. To query, you would join to it:
SELECT *
FROM TimePoints
LEFT JOIN myOtherTable ON ...
WHERE TimePoints.DateTime >= (nowMinus15min) AND TimePoints.DateTime <= now
I have a function in my VBA code which sets a specific Date format for a textbox.
This is my code to verify the Date is in the correct format:
Function CheckDate(DateStg As String) As Boolean
If DateStg = "" Then
' Accept an empty value in case user has accidentally moved to a new row
CheckDate = True
lblMessage.Caption = ""
Exit Function
End If
If IsDate(DateStg) Then
CheckDate = True
lblMessage.Caption = ""
Else
CheckDate = False
lblMessage.Caption = "Sorry I am unable to recognise " & DateStg & " as a date."
End If
End Function
In addition to checking if the date in the textbox is an actual date, I need to verify that the textbox date is not less than the current date minus 1 month, and. Also, I would like to verify that the date is not more than the current date plus 1 year.
So:
DateStg > Today - 1 month
DateStg < Today + 1 year
Thanks for your help in advance.
You have a few functions you can use:
''Assume date is not good
DateOK=False
If IsDate(DateStg) Then
If DateStg > dateAdd("m",-1,Date()) _
And DateStg < dateAdd("m",12,Date()) Then
''Date is good
DateOK=True
End If
End if
For the most part, textboxes can be set to only accept dates and you can set validation rules to check the range, so code may not be necessary.
If you just want to check the date, you can use the DateAdd-function to get the dates to compare:
'Subtract a month from today and return it as a string
Format(DateAdd("m", -1, Now), "yyyy-mm-dd")
'Add a year to today and return it as a string
Format(DateAdd("yyyy", 1, Now), "yyyy-mm-dd")