I have a MS Access table that has a list of jobs that were executed (Job ID, StartDate, EndDate) I need to find the count of days in a specified date range (e.g. between 1st Jan and 30 Jun) that a user selects using textboxes that have at least 1 job open ie between StartDate and EndDate. I have some experience with VBA and with SQL (not very good with grouping).
Could anyone assist me with a suggestion of how I could get this count?
JobID| StartDate| EndDate
1142| 03-Jan-14| 04-Feb-14|
1143| 13-Mar-14| 18-May-14|
1144| 03-Jan-14| 29-Jan-14|
1145| 20-Jan-14| 13-Apr-14|
1146| 03-Jan-14| 07-Jan-14|
You could create a calendar table as suggested in the comments and add a button called cmdCountJobDays to your form.
The below code will check all possible dates in the selected date range against the job dates. A bit clunky but it will get you there :-)
Private Sub cmdCountJobDays_Click()
Dim StartDate as Date
Dim EndDate as Date
StartDate = me.txtYourStartDateTextBox
EndDate = me.txtYourEndDateTextBox
SQLGetJobCountPeriod = SQLGetJobCountPeriod & "Select CalendarDate from tblCalendarDates where CalendarDate >=" & cdbl(StartDate)
SQLGetJobCountPeriod = SQLGetJobCountPeriod & " and CalendarDate <= " & cdbl(EndDate)
Set dateschecked = CurrentDb.OpenRecordset(SQLGetJobCountPeriod)
If dateschecked.EOF = False Then
dateschecked.MoveFirst
CountOpenJobDays = 0
CountAllDays = 0
Do While dateschecked.EOF = False
CurrentCheckDate = CDbl(dateschecked.Fields("CalendarDate"))
SQLJobDates = "Select StartDate, EndDateDate from jobdetails "
Set Jobdates = CurrentDb.OpenRecordset(SQLJobDates)
If Jobdates.EOF = False Then
Jobdates.MoveFirst
Do While Jobdates.EOF = False
Jobstartdate = CDbl(Jobdates.Fields("StartDate"))
Jobenddate = CDbl(Jobdates.Fields("EndDate"))
If (CurrentCheckDate > Jobstartdate - 1) And (CurrentCheckDate < Jobenddate + 1) Then
CountJobOpen = CountJobOpen + 1
Exit Do
End If
Jobdates.MoveNext
Loop
End If
CountAllDays = CountAllDays + 1
dateschecked.MoveNext
Loop
End If
msgbox CountJobOpen
End Sub
The count is using a datediff function.
datediff(dd,startdate, enddate)
"dd" tells it to find days, start date would be 1/03/2014, and end date would be 2/04/2014 as an example for your first line
Related
i get the error "Data type mismatch in criteria expression." in a query.
Like this the query works perfectly
WorkingDays([ORDER_NOTIFICATION_DATE],[OP_DISTRIBUTION_DATE]) AS
BOOKING_DAYS, IIf([BOOKING_DAYS]>8,"IS LATE","ON TIME") AS BOOKING_DELAYED
FROM JOB INNER JOIN [ORDER] ON JOB.[JOB_ID] = ORDER.[JOB_ID]
WHERE (((ORDER.ORDER_NOTIFICATION_DATE) Is Not Null) AND
((ORDER.OP_DISTRIBUTION_DATE) Is Not Null));
when i try to put another criteria it shows me the error:
WorkingDays([ORDER.ORDER_NOTIFICATION_DATE],[ORDER.OP_DISTRIBUTION_DATE]) AS
BOOKING_DAYS, IIf([BOOKING_DAYS]>8,"IS LATE","ON TIME") AS BOOKING_DELAYED
FROM JOB INNER JOIN [ORDER] ON JOB.[JOB_ID] = ORDER.[JOB_ID]
WHERE (((ORDER.ORDER_NOTIFICATION_DATE) Is Not Null) AND
((ORDER.OP_DISTRIBUTION_DATE) Is Not Null) AND
((WorkingDays([ORDER.ORDER_NOTIFICATION_DATE],
[ORDER.OP_DISTRIBUTION_DATE]))>8));
WorkingDays returns an integer, i tried most of the solutions proposed in other posts.
this is WorkingDays:
Public Function WorkingDays(StartDate As Date, EndDate As Date) As Integer
'....................................................................
' Name: WorkingDays
' Inputs: StartDate As Date
' EndDate As Date
' Returns: Integer
' Author: Arvin Meyer
' Date: February 19, 1997
' Comment: Accepts two dates and returns the number of weekdays between them
' Note that this function does not account for holidays.
'....................................................................
On Error GoTo Err_WorkingDays
Dim intCount As Integer
intCount = 0
Do While StartDate <= EndDate
'Make the above < and not <= to not count the EndDate
Select Case Weekday(StartDate)
Case Is = 1, 7
intCount = intCount
Case Is = 2, 3, 4, 5, 6
intCount = intCount + 1
End Select
StartDate = StartDate + 1
Loop
WorkingDays = intCount
Exit_WorkingDays:
Exit Function
Err_WorkingDays:
Select Case Err
Case Else
MsgBox Err.Description
Resume Exit_WorkingDays
End Select
End Function
I see you're using Is Not Null and a function that can't handle Null values in the same query.
While you may assume this could work just fine, as the Null values get filtered out, they still get passed to this function and create an error.
Use Nz to escape the nulls getting passed to the function:
WorkingDays(Nz([ORDER.ORDER_NOTIFICATION_DATE], 0),Nz([ORDER.OP_DISTRIBUTION_DATE], 0)) AS
BOOKING_DAYS, IIf([BOOKING_DAYS]>8,"IS LATE","ON TIME") AS BOOKING_DELAYED
FROM JOB INNER JOIN [ORDER] ON JOB.[JOB_ID] = ORDER.[JOB_ID]
WHERE (((ORDER.ORDER_NOTIFICATION_DATE) Is Not Null) AND
((ORDER.OP_DISTRIBUTION_DATE) Is Not Null) AND
((WorkingDays(Nz([ORDER.ORDER_NOTIFICATION_DATE], 0),
Nz([ORDER.OP_DISTRIBUTION_DATE], 0)))>8));
All,
I have written a little procedure which I would like a for each loop to insert the current month into the first cell "01"/MM/YY and then add one month to the date as it goes through the loop. Using the example below;
K1 = 01/06/2018
L1 = 01/07/2018
M1 = 01/08/2018 etc
The code I am using is below - The error is on the DateAdd line.
Sub test()
Dim dt As date
dt = "01/" & Application.Text(Now(), "MM/YY")
Dim i As Double
i = 1
For Each c In Range("K1:XFD1")
If c.Value = "" Then Exit For
c.Value = dt
'change date to one months time
dt = DateAdd(m, i, dt)
i = i + 1
Next c
End Sub
Any help regarding this would be much appreciated.
Put "m" not m. m would be a variable. "m" is a literal string representing the argument being "month".
dt = DateAdd("m", i, dt)
I have 2 tables, Table 1 and Table 2. Both the tables have one date column each. I am inserting the first Monday of the month on top of the table 1 and Table 2, both. I will fetch date value from each row of the table 2, and if it is more than the value on top of the table, I will insert 0. If the date value in the table 2 is "16/02/2018", and it is not a Monday, I will insert the Monday after it, and the value 1 for that record.How can I proceed with it? Please help.
Dim col_tab2_dat as Date
first_day = DateSerial(Year(Date), Month(Date), 1)
last_day = DateSerial(Year(Date), Month(Date) + 1, 1)
curr_month= Format(first_day, "mmm")
w = Weekday(first_day , vbMonday)
FirstMonday = first_day + IIf(w <> 1, 8 - w, 0)
tab1_last_lin = ws.Columns(2).Find("Total(T1)").Row
tab2_last_lin = ws.Columns(2).Find("Total(T2)").Row
find_tab2 = ws.Columns(1).Find("Table 2").Row
last_lin = Range("B" & Rows.Count).End(xlUp).Row
last_col_tab1 = ws.Cells(tab1_last_lin, ws.Columns.Count).End(xlToLeft).Column
last_col_tab2 = ws.Cells(tab2_last_lin, ws.Columns.Count).End(xlToLeft).Column
last_dat = ws.Cells(2, last_col_tab1 - 1).Value
new_date = last_dat + 7
For i = find_tab2 + 3 to tab2_last_lin
ws.Cells(find_tab2 + 3, 1).Value = col_tab2_dat
If col_tab2_dat > last_dat Then
I am stuck here. What to do next?
End If
Next i
Here is a function that will return the next Monday:
Public Function GetNextMonday(dt As Date) As Date
Do Until Weekday(dt, vbSunday) = 2
dt = DateAdd("d", 1, dt)
Loop
GetNextMonday = dt
End Function
Here's a function that will work for any day of the week.
NextWeekday Function:
Function NextWeekday(FromDate As Date, vbWeekday As VbDayOfWeek) As Date
If Weekday(FromDate) < vbWeekday Then
NextWeekday = FromDate + vbWeekday - Weekday(FromDate)
Else
NextWeekday = FromDate + 7 + vbWeekday - Weekday(FromDate)
End If
End Function
It takes two arguments:
FromDate: The Date of which you are wanting to find the next weekday of. You can simply use "Date" as the argument for today's Date.
vbWeekday: The upcoming day of the week you are wanting the date for.
VBA Example:
Once you've added the above function to your code module, it's easy to get its value:
Sub Main()
Dim NextThursday As Date
NextThursday = NextWeekday(Date, vbThursday)
End Sub
Worksheet Formula Example:
Or you can use it as a worksheet function:
=NextWeekday(Today(), 5)
Worksheet Formula Considerations:
Notice in the worksheet formula we had to remove the vbThursday constant as worksheet functions doesn't have this functionality built-in. However, if you want to still use these constant values in your worksheet, you can create them yourself by using the Name Manager.
Click on the Formulas Tab, then on Define Name
Start creating your constants starting at vbSunday = 1 through vbSaturday = 7 by placing the Constant Name in the Name: field, and the value in the Refers to: field:
And there you have it! You can now refer to them using your named values:
Additional Example Usage:
Comments:
The benefit of using the VbDayOfWeek Type is that you will now gain IntelliSense when using the function:
Working on populating a row in excel with dates between a start date and current date. The population is weekly and below is the function I have made. It works fine up until the point where it doesn't stop but continues to go infinitely until there is an overflow error hence my assumption is that CurrentDate is not working properly.
The 2 dates used are StartDate = 04/1/2016 and CurrentDate = 12/07/2017.
Any help or suggestions would be greatly appreciated.
Public Function PopulateStartOfWeekDates()
Dim wsCRC As Worksheet
Set wsCRC = Worksheets("CRC")
Dim StartDate As Date
Dim CurrentDate As Date
StartDate = FirstMondayOfYear()
CurrentDate = Date
Dim WeekOffset As Integer
Dim i As Integer
i = 12
WeekOffset = 0
Debug.Print StartDate
Debug.Print CurrentDate
Do While StartDate < CurrentDate
wsCRC.Cells(5, i) = StartDate + WeekOffset
wsCRC.Cells(5, i).EntireColumn.AutoFit
i = i + 1
WeekOffset = WeekOffset + 7
Loop
End Function
If you decide you need to maintain the value of StartDate (e.g. to use later in the code), you could replace your loop with:
i = 0
Do While StartDate + i * 7 < CurrentDate
wsCRC.Cells(5, i + 12) = StartDate + i * 7
wsCRC.Cells(5, i + 12).EntireColumn.AutoFit
i = i + 1
Loop
After looking at this myself I realized I wasn't increasing the startdate hence the loop was infinite. Thanks to #Nathan_Sav for pointing this out in the comments too.
I have data in my excel sheet that can be reproduced by this function:
sub dummy_data
start_date = Sheets("Blad1").Cells(2, 4) = "20-03-2014"
end_date = Sheets("Blad1").Cells(3, 4) = 20-04-2014"
End sub
Now I would like to create a list of all weeks between these dates. Therefore I did:
Sub print_dates
start_date = Sheets("Blad1").Cells(2, 4)
end_date = Sheets("Blad1").Cells(3, 4)
'Get number of weeks
r = (end_date - start_date) / 7
r = Round(r)
new_date = start_date
counter = 0
While (new_date < (end_date - 7))
For i = 1 To r
counter = counter + 7
new_date = start_date + counter
'print date
Sheets("Blad1").Cells(i, 4).FormulaLocal = new_date
Next i
Wend
End sub
This works a little however but it gives me always one row too much. So if I
enter start_date = 23-3-2013 and end_date 04-04-2013 I get one value after 04-04-2013.
Any thoughts on how I can an overview with only the weeks between a certain range?
The problem is the For Loop inside the While Loop.
That said, I just tested this code and it worked and is simpler.
Sub print_dates()
start_date = Sheets("Blad1").Cells(2, 4)
end_date = Sheets("Blad1").Cells(3, 4)
new_date = start_date
i = 1
While (new_date < (end_date - 7))
new_date = new_date + 7
'print date
Sheets("Blad1").Cells(i, 5).FormulaLocal = new_date
i = i + 1
Wend
End Sub
try the following code:
Sub print_dates()
start_date = Sheets("Blad1").Cells(2, 4)
end_date = Sheets("Blad1").Cells(3, 4)
'Get number of weeks
r = (end_date - start_date) / 7
r = Round(r)
new_date = start_date
counter = 0
For i = 1 To r
If new_date + 7 <= end_date Then
counter = counter + 7
new_date = start_date + counter
'print date
Sheets("Blad1").Cells(i, 5).FormulaLocal = new_date
End If
Next i
End Sub
Try using datediff to determine how many weeks. Just easier.
MSDN has a really good datediff function tutorial here
R = DateDiff("w", startdate, enddate) ' Determine week difference between two dates.
Also, I suspect the extra week is being added because the code makes sunday the first day of the week, not monday. So you would have to also take in account the days between currentday and vbsunday. Or just put that in the datediff function like this.
R = DateDiff("w", startdate, enddate, vbmonday or whatever current day.)