Simple Event Management

  • Thread starter Thread starter robboll
  • Start date Start date
R

robboll

I am trying to set up a VBA routine (query) that counts the number of
days
HERE vs AWAY. The sample events start (e.g., a_s) and end (e.g.,
a_e) at random dates within the period: July 1 thru Aug 6

Sample Events:
a_s: 5-Jul
a_e: 21-Jul
c_s: 5-Jul
c_e: 21-Jul
e_s: 6-Jul
e_e: 24-Jul
g_s: 4-Jul
g_e: 20-Jul
i_s: 6-Jul
i_e: 20-Jul
k_s: 26-Jul
k_e: 4-Aug

All start and stop dates for all events are all on the same row like:
member, a_s, a_e, c_s, c_e, e_s, e_e, etc.

The routine should see that events a,c,e,g, and I overlap, and that
event g (July 4) is the earliest of the overlapping events. Event e
(July 24) is the latest of the overlapping events accounting for 21
days. It should also see that event k (July 26 thru August 4)
accounts for 10 days. Total Event days: 31 (Away)

Total days of period Jul 1 thru Aug 6 = 37 days
37 - 31 (Away) = 6 (Here)

All event periods are "AWAY" the rest are considered "HERE"

Graphing these dates out (the hard way) for the period July 1 thru Aug
6 I come up with:

AWAY: 31 DAYS
HERE: 6 DAYS

Is there a VBA routine or an array that can handle this routine in a
query? Any help greatly appreciated!!!

I hope this clears up what I am trying to do conceptually. Appreicate
any help with this!

RBollinger
 
JString sent this solution: Works great in a form. Needs to work in
a query.

Private Function dateCount(start_date As Date, end_date As Date,
Optional
mode = "away") As Integer
On Error GoTo ErrHandler
Dim strDateFields(2) As Variant
Dim intdRange As Integer
Dim d As Integer
Dim i As Integer
Dim dateCompare As Date
Dim intAwayCount As Integer


strDateFields(0) = Array("a_s", "c_s", "e_s", "g_s", "i_s",
"k_s")
strDateFields(1) = Array("a_e", "c_e", "e_e", "g_e", "i_e",
"k_e")


intdRange = DateDiff("d", start_date, end_date)
For d = 0 To intdRange
dateCompare = start_date + d
For i = 0 To UBound(strDateFields(0))
If dateCompare >= Me.Controls(strDateFields(0)(i)) Then
If dateCompare <= Me.Controls(strDateFields(1)(i))
Then
intAwayCount = intAwayCount + 1
Exit For
End If
End If
Next i
Next d


If mode = "here" Then
dateCount = DateDiff("d", start_date, end_date) + 1 -
intAwayCount
ElseIf mode = "away" Then
dateCount = intAwayCount
Else: GoTo ErrHandler
End If


Exit Function
ErrHandler:
MsgBox "dateCount Error." & vbCr & vbCr & Err.Description, ,
"Error"
End Function
 
What are your actual fields? If you have multiple start and end dates in a
single record then IMHO this is wrong and needs to be corrected. If this is
your structure and you can't or won't correct it, you can start be creating a
normalizing union query that takes each pair of dates and creates a single
record.
SELECT Member, a_s as StartDate, a_e as EndDate, "a" as Event
FROM tblSpreadsheet
UNION ALL
SELECT Member, c_s, c_e, "c"
FROM tblSpreadsheet
UNION ALL
-- etc for all pairs --;

You can then more easily answer the questions you need. You may need to
create a query of all dates between your start and end dates to get results.
 
What are your actual fields? If you have multiple start and end dates in a
single record then IMHO this is wrong and needs to be corrected. If this is
your structure and you can't or won't correct it, you can start be creating a
normalizing union query that takes each pair of dates and creates a single
record.
SELECT Member, a_s as StartDate, a_e as EndDate, "a" as Event
FROM tblSpreadsheet
UNION ALL
SELECT Member, c_s, c_e, "c"
FROM tblSpreadsheet
UNION ALL
-- etc for all pairs --;

You can then more easily answer the questions you need. You may need to
create a query of all dates between your start and end dates to get results.

--
Duane Hookom
Microsoft Access MVP















- Show quoted text -
Click to expand...

Duane, this is a case record where multiple agencies can become
involved simultaneously.

Example:
Case: 123 (opened July 1, 2008)
Date Sent to A: 5-Jul ~ Date Returned from A: 21-Jul ~ Date Sent to
C: 5-Jul ~ Date Returned from C: 21-July etc. etc.
Case: 123 (closed Aug 5, 2008)

The following function works in a form, accounting for modes "here" or
"away" depending on which result you are looking for. I'm really
looking for "here" which renders 6 days with the example data.

Do you know how to modify this so it will work exclusively in a query?
~~~~~~~~~~~~~~~~~~~~~~~~

Private Function dateCount(start_date As Date, end_date As Date,
Optional
mode = "here") As Integer
On Error GoTo ErrHandler
Dim strDateFields(2) As Variant
Dim intdRange As Integer
Dim d As Integer
Dim i As Integer
Dim dateCompare As Date
Dim intAwayCount As Integer


strDateFields(0) = Array("a_s", "c_s", "e_s", "g_s", "i_s",
"k_s")
strDateFields(1) = Array("a_e", "c_e", "e_e", "g_e", "i_e",
"k_e")


intdRange = DateDiff("d", start_date, end_date)
For d = 0 To intdRange
dateCompare = start_date + d
For i = 0 To UBound(strDateFields(0))
If dateCompare >= Me.Controls(strDateFields(0)(i)) Then
If dateCompare <= Me.Controls(strDateFields(1)(i))
Then
intAwayCount = intAwayCount + 1
Exit For
End If
End If
Next i
Next d


If mode = "here" Then
dateCount = DateDiff("d", start_date, end_date) + 1 -
intAwayCount
ElseIf mode = "away" Then
dateCount = intAwayCount
Else: GoTo ErrHandler
End If


Exit Function
ErrHandler:
MsgBox "dateCount Error." & vbCr & vbCr & Err.Description, ,
"Error"
End Function

~~~~~~~~~~~~~~~~~~~~~~~~

RBollinger
 
I don't think you understand my position. I wouldn't do anything without
changing the data structure or at lease using the union query.

Perhaps someone else has less hang-ups than I do regarding your current
structure and solution.
 
I don't think you understand my position. I wouldn't do anything without
changing the data structure or at lease using the union query.

Perhaps someone else has less hang-ups than I do regarding your current
structure and solution.
--
Duane Hookom
Microsoft Access MVP














- Show quoted text -
Click to expand...

Someone already responded (as posted) and it works great using an
array. I am thinking that I should be able to adapt this function to
a query exclusively. IMHO you can. You've helped before. You're
pretty good. ;)
 
i do agree with duane the more simple appearign the structure the more
difficult it is to do queries and other things. if you have a
properly normalised DB then it makes things eaiser down the track ie
not everything on one line.

Regards
Kelvan
 
Hey again robbol.

I made some slight modifications to the code that I gave you, and I hope
that it will work for you. Mode can be either "here" or "away" and is pretty
much self-explanitory. It will return an integer value greater than or equal
to zero if it completes successfully, otherwise it returns -1 to indicate an
error.

To use it, create a new module from the database window. Double-click on it
and paste this code into it:

'*****Begin Code*****

Option Compare Database

Public Function dateCount(start_date, end_date, _
a_s, a_e, c_s, c_e, e_s, e_e, g_s, g_e, i_s, i_e, k_s, k_e, _
Optional mode = "away") As Integer
On Error GoTo ErrHandler
Dim strDateFields(2) As Variant
Dim intdRange As Integer
Dim d As Integer
Dim i As Integer
Dim dateCompare As Date
Dim intAwayCount As Integer

strDateFields(0) = Array(a_s, c_s, e_s, g_s, i_s, k_s)
strDateFields(1) = Array(a_e, c_e, e_e, g_e, i_e, k_e)

intdRange = DateDiff("d", start_date, end_date)
For d = 0 To intdRange
dateCompare = start_date + d
For i = 0 To UBound(strDateFields(0))
If dateCompare >= strDateFields(0)(i) Then
If dateCompare <= strDateFields(1)(i) Then
intAwayCount = intAwayCount + 1
Exit For
End If
End If
Next i
Next d

If mode = "here" Then
dateCount = intdRange + 1 - intAwayCount
ElseIf mode = "away" Then
dateCount = intAwayCount
Else
GoTo ErrHandler
End If

Exit Function
ErrHandler:
dateCount = -1
End Function
'*****End Code*****

Next thing is to paste this expression into a new, blank query:

dateCount ( [YourTable]![start_date] , [YourTable]![end_date] ,
[YourTable]![a_s] , [YourTable]![a_e] , [YourTable]![c_s] , [YourTable]![c_e]
, [YourTable]![e_s] , [YourTable]![e_e] , [YourTable]![g_s] ,
[YourTable]![g_e] , [YourTable]![i_s] , [YourTable]![i_e] , [YourTable]![k_s]
, [YourTable]![k_e] , "here")

Note that YourTable, start_date and end_date (these two are now field names)
should be replaced with the appropriate names.
 
Back
Top