Calculating Dates Query 1

[iuianj07]

Hello guys,

I have a MAXDate query, that gives the MAX Date between 3 different dates, for me to achieve this I have a module:

Public Function Maximum(ParamArray MyArray()) As Variant

   Dim intLoop As Long

   Maximum = Null
   For intLoop = LBound(MyArray) To UBound(MyArray)

       If IsNull(MyArray(intLoop)) Then
           'do nothing
       ElseIf IsNull(Maximum) Then
           Maximum = MyArray(intLoop)
       ElseIf MyArray(intLoop) > Maximum Then
           Maximum = MyArray(intLoop)
       End If

   Next

End Function

Then on the MaxDate query:

SELECT Job_Tracking.ReportingPeriod, Job_Tracking.LoanNumber, JobTracking_PropertyCount.CountOfLoanNumber AS [Property Count (<>SUM)], Job_Tracking.DateAssigned, Job_Tracking.RushReqDate, Job_Tracking.ResolvedIssueDate, Maximum([DateAssigned],[RushReqDate],[ResolvedIssueDate]) AS MaxDate
FROM Job_Tracking LEFT JOIN JobTracking_PropertyCount ON (Job_Tracking.LoanNumber = JobTracking_PropertyCount.LoanNumber) AND (Job_Tracking.ReportingPeriod = JobTracking_PropertyCount.ReportingPeriod)
GROUP BY Job_Tracking.ReportingPeriod, Job_Tracking.LoanNumber, JobTracking_PropertyCount.CountOfLoanNumber, Job_Tracking.DateAssigned, Job_Tracking.RushReqDate, Job_Tracking.ResolvedIssueDate;

My main problem though is, if for example I want to add another column, let's say DueDate2: [MaxDate]+1 it gives an error.

Any idea why it doesn't calculate the date? is it because MaxDate is a function?

Thanks

 

[iuianj07]

Hello MajP,

I researched on the web, and saw a function for excluding Holidays using a table (DLookup)... below is the code:

Public Function DateSkipHoliday( _
  ByVal datDate As Date, _
  Optional ByVal booReverse As Boolean) _
  As Date

  Const cstrHolidayTable  As String = "tblHoliday"
  Const cstrHolidayField  As String = "HolidayDate"
  
  While Not IsNull(DLookup(cstrHolidayField, cstrHolidayTable, cstrHolidayField & " = " & Format(datDate, "\#m\/d\/yyyy\#")))
    datDate = DateAdd("d", 1 - Abs(2 * booReverse), datDate)
  Wend

  DateSkipHoliday = datDate

End Function

then on my query... including all the other functions above..

DueDate: dateAddNoWeekends(DateSkipHoliday(Maximum([TotalScope_MaxDate].[DateAssigned],[TotalScope_MaxDate].[RushReqDate],[TotalScope_MaxDate].[ResolvedIssueDate])),[TotalTATTime])

when I run the query... the DueDate column result doesn't change, it still gives the result kind of like when DateSkipHoliday is not in there...

Can you please help me re-write the code above, or help use a DLookup function with the code you have posted previously?

Any help is greatly appreciated.

thanks

 

[iuianj07]

or how could I add the function isHoliday that MajP wrote above to the

dateAddNoWeekends(Maximum([MaxDate].[DateAssigned],[RushReqDate],[ResolvedIssueDate]),[TotalTATTime]) As DueDate expression?

Thanks again

 

[MajP]

I would revise the original function to skip both weekends and holidays.

Public Function isWeekend(ByVal dtmDate As Date) As Boolean
  If Weekday(dtmDate) = vbSaturday Or Weekday(dtmDate) = vbSunday Then isWeekend = True
End Function

Public Function isHoliday(ByVal dtmDate As Date) As Boolean
  Dim strWhere As String
  Const cstrHolidayTable  As String = "tblHoliday"
  Const cstrHolidayField  As String = "HolidayDate"
  strWhere = cstrHolidayField & " = " & Format(dtmDate, "\#m\/d\/yyyy\#")
  isHoliday = Not IsNull(DLookup(cstrHolidayField, cstrHolidayTable, strWhere))
End Function

Public Function dateAddNoWeekendsHolidays(dtmDate As Variant, intDaysToAdd As Integer) As Variant
  'Pass in your date: dtmDate
  'Pass in the number of days to add: intDaysToAdd

  'Direction: Determine if you are adding or subtracting days.  If days to add is negative (-1), positive (1), or
  '0 then do nothing.
  Dim direction As Integer
  'You need to loop the number of days. But only increment the counter if it is not a weekend or holiday. Not a weekend is
  ' a weekday value of 1 (vbSunday) or 7 (vbSaturday)
  Dim intCount As Integer
  'just make sure they pass in legitimate values or do nothing
 If IsNumeric(intDaysToAdd) And IsDate(dtmDate) Then
    'set the return value equal the date passed in.
    dateAddNoWeekendsHolidays = dtmDate
    'Determine if you add a day, delete a day, or exit the function
    If intDaysToAdd < 0 Then
     direction = -1
    ElseIf intDaysToAdd > 0 Then
     direction = 1
    Else
     Exit Function
    End If
    'Start looping until you go intDaysToAdd, but only increment if not a weekend or holiday
    Do
        dateAddNoWeekendsHolidays = dateAddNoWeekendsHolidays + 1 * (direction)
        If Not isWeekend(dateAddNoWeekendsHolidays) And Not isHoliday(dateAddNoWeekendsHolidays) Then
         intCount = intCount + 1
        End If
    Loop Until intCount = Abs(intDaysToAdd)
    'need the absolute value because if they pass in -5 you want to
    'increment 5 times
End If
End Function

 

[iuianj07]

Thanks MajP,

Thank you for your help, I wish I could add another star for you

I revised the original function to:

DueDate: dateAddNoWeekendsHolidays(Maximum([TotalScope_MaxDate].[DateAssigned],[TotalScope_MaxDate].[RushReqDate],[TotalScope_MaxDate].[ResolvedIssueDate]),[TotalTATTime])

When I run the query, it gives the correct Due Date, although it runs really slow whenever I scroll through records, any idea what could have caused this? Not a big deal though, since it is giving the right due date...

Thanks again!

 

[MajP]

This function is pretty slow if you think about what it is doing. For each record you begin looping and check every day for a weekend and then check a table for a holiday. Dlookups are especially known to be slow. I would replace it with this code.

http://allenbrowne.com/ser-42.html

Public Function ELookup(Expr As String, Domain As String, Optional Criteria As Variant, _
    Optional OrderClause As Variant) As Variant
On Error GoTo Err_ELookup
    'Purpose:   Faster and more flexible replacement for DLookup()
    'Arguments: Same as DLookup, with additional Order By option.
    'Return:    Value of the Expr if found, else Null.
    '           Delimited list for multi-value field.
    'Author:    Allen Browne. allen@allenbrowne.com
    'Updated:   December 2006, to handle multi-value fields (Access 2007 and later.)
    'Examples:
    '           1. To find the last value, include DESC in the OrderClause, e.g.:
    '               ELookup("[Surname] & [FirstName]", "tblClient", , "ClientID DESC")
    '           2. To find the lowest non-null value of a field, use the Criteria, e.g.:
    '               ELookup("ClientID", "tblClient", "Surname Is Not Null" , "Surname")
    'Note:      Requires a reference to the DAO library.
    Dim db As DAO.Database          'This database.
    Dim rs As DAO.Recordset         'To retrieve the value to find.
    Dim rsMVF As DAO.Recordset      'Child recordset to use for multi-value fields.
    Dim varResult As Variant        'Return value for function.
    Dim strSql As String            'SQL statement.
    Dim strOut As String            'Output string to build up (multi-value field.)
    Dim lngLen As Long              'Length of string.
    Const strcSep = ","             'Separator between items in multi-value list.

    'Initialize to null.
    varResult = Null

    'Build the SQL string.
    strSql = "SELECT TOP 1 " & Expr & " FROM " & Domain
    If Not IsMissing(Criteria) Then
        strSql = strSql & " WHERE " & Criteria
    End If
    If Not IsMissing(OrderClause) Then
        strSql = strSql & " ORDER BY " & OrderClause
    End If
    strSql = strSql & ";"

    'Lookup the value.
    Set db = DBEngine(0)(0)
    Set rs = db.OpenRecordset(strSql, dbOpenForwardOnly)
    If rs.RecordCount > 0 Then
        'Will be an object if multi-value field.
        If VarType(rs(0)) = vbObject Then
            Set rsMVF = rs(0).Value
            Do While Not rsMVF.EOF
                If rs(0).Type = 101 Then        'dbAttachment
                    strOut = strOut & rsMVF!FileName & strcSep
                Else
                    strOut = strOut & rsMVF![Value].Value & strcSep
                End If
                rsMVF.MoveNext
            Loop
            'Remove trailing separator.
            lngLen = Len(strOut) - Len(strcSep)
            If lngLen > 0& Then
                varResult = Left(strOut, lngLen)
            End If
            Set rsMVF = Nothing
        Else
            'Not a multi-value field: just return the value.
            varResult = rs(0)
        End If
    End If
    rs.Close

    'Assign the return value.
    ELookup = varResult

Exit_ELookup:
    Set rs = Nothing
    Set db = Nothing
    Exit Function

Err_ELookup:
    MsgBox Err.Description, vbExclamation, "ELookup Error " & Err.number
    Resume Exit_ELookup
End Function

Then in my code change the dlookup to elookup.
Overall my code is still not very efficient, but report back if you improve performance with this.

 

[iuianj07]

Hello,

I created the above function and I changed the line on your function to:

isHoliday = Not IsNull(ELookup(cstrHolidayField, cstrHolidayTable, strWhere))

and when I tried to run the query, it gave a compile error:

Expected variable or procedure, not module

Have any idea why it gave the compile error? I appreciate your help.

Thanks

 

[MajP]

you named the module the same as the procedure or function

 

[iuianj07]

Oops sorry, that was a dumb mistake on my part, I apologize...

The problem now though is when I run the query, it gives an error Undefined function 'Maximum' in expression...

What could have caused this to not recognize the 'Maximum' function?

The code for Maximum is:

Public Function Maximum(ParamArray MyArray()) As Date

   Dim intLoop As Long
  
   For intLoop = LBound(MyArray) To UBound(MyArray)

       If IsNull(MyArray(intLoop)) Then
           'do nothing
       ElseIf IsNull(Maximum) Then
           Maximum = MyArray(intLoop)
       ElseIf MyArray(intLoop) > Maximum Then
           Maximum = MyArray(intLoop)
       End If

   Next

End Function

and the SQL for the query that uses dateAddNoWeekendsHolidays:

SELECT TotalScope_MaxDate.ReportingPeriod, TotalScope_MaxDate.LoanNumber, TotalScope_MaxDate.DateAssigned, TotalScope_MaxDate.RushReqDate, TotalScope_MaxDate.ResolvedIssueDate, TotalScope_MaxDate.MaxDate, IIf([TATRush]=0,[TATDays],[TATRush]) AS TotalTATTime, dateAddNoWeekendsHolidays(Maximum([TotalScope_MaxDate].[DateAssigned],[TotalScope_MaxDate].[RushReqDate],[TotalScope_MaxDate].[ResolvedIssueDate]),[TotalTATTime]) AS DueDate
FROM (TotalScope_MaxDate LEFT JOIN TATDays ON (TotalScope_MaxDate.MAXDateMonth = TATDays.Month) AND (TotalScope_MaxDate.MAXDateYear = TATDays.Year)) LEFT JOIN TOtalScope_TATRush ON (TotalScope_MaxDate.LoanNumber = TOtalScope_TATRush.LoanNumber) AND (TotalScope_MaxDate.ReportingPeriod = TOtalScope_TATRush.ReportingPeriod)
GROUP BY TotalScope_MaxDate.ReportingPeriod, TotalScope_MaxDate.LoanNumber, TotalScope_MaxDate.DateAssigned, TotalScope_MaxDate.RushReqDate, TotalScope_MaxDate.ResolvedIssueDate, TotalScope_MaxDate.MaxDate, IIf([TATRush]=0,[TATDays],[TATRush]), TOtalScope_TATRush.TATRush, TATDays.TATDays;

Thank you very much

 

[iuianj07]

Hello,

for some reason, the Maximum function is kinda messing up, therefore I couldn't run the query right... I am in the process of figuring it out/resolving the issue... I will let you know about the improved performance right after I get this fixed...

Thanks again for your help...

 

[iuianj07]

the query is working now... and with the ELookup change.. The query slightly improved, but not that significant, it still sometimes run slow when scrolling through records, but it's giving right results anyway...

I appreciate the help

Thank you again MajP!

 

[MajP]

There are probably a few things to tweak to make this faster, but bottom line using functions in a query is pretty slow. There is a lot going on with this function. If I was going to use the duedate information a lot in multiple reports and queries, I would make a field and write to that field using an Update query or code.
Some people will say "you never store calculated data", but that should be "never store calculated data that is simple to calculate". Sometimes running code once to update a table is orders of magnitude faster then dynamically calculating in a query.

 

[iuianj07]

Thanks for the tip MajP...

I appreciate your help, and congratulations for beint TipMaster for the week ;-)

 

[iuianj07]

Hello,

The query below, when being run, gives the result between 5-10 seconds:

SELECT TotalScope_MaxDate.ReportingPeriod, TotalScope_MaxDate.LoanNumber, TotalScope_MaxDate.ConsolidatedStatement, TotalScope_MaxDate.PropertyNumber, TotalScope_MaxDate.DateAssigned, TotalScope_MaxDate.RushReqDate, TotalScope_MaxDate.ResolvedIssueDate, TotalScope_MaxDate.MaxDate, IIf([TATRush]=0,[TATDays],[TATRush]) AS TotalTATTime, dateAddNoWeekendsHolidays(Maximum([TotalScope_MaxDate].[DateAssigned],[TotalScope_MaxDate].[RushReqDate],[TotalScope_MaxDate].[ResolvedIssueDate]),[TotalTATTime]) AS DueDate
FROM (TotalScope_MaxDate LEFT JOIN TATDays ON (TotalScope_MaxDate.MAXDateYear = TATDays.Year) AND (TotalScope_MaxDate.MAXDateMonth = TATDays.Month)) LEFT JOIN TOtalScope_TATRush ON (TotalScope_MaxDate.ReportingPeriod = TOtalScope_TATRush.ReportingPeriod) AND (TotalScope_MaxDate.LoanNumber = TOtalScope_TATRush.LoanNumber)
WHERE (((TotalScope_MaxDate.Withdraw)=0))
GROUP BY TotalScope_MaxDate.ReportingPeriod, TotalScope_MaxDate.LoanNumber, TotalScope_MaxDate.ConsolidatedStatement, TotalScope_MaxDate.PropertyNumber, TotalScope_MaxDate.DateAssigned, TotalScope_MaxDate.RushReqDate, TotalScope_MaxDate.ResolvedIssueDate, TotalScope_MaxDate.MaxDate, IIf([TATRush]=0,[TATDays],[TATRush]), TOtalScope_TATRush.TATRush, TATDays.TATDays;

However, when the query below is used... it takes hours before it gives results, and most of the time it freezes the database... Do you know the difference between the 2 queries and what could have caused this 2nd query to not run properly? Any help is greatly appreciated.

SELECT Switch([job_Tracking].[Signed Off] Is Not Null,"Signed Off",[job_Tracking].[On hold for Issue] Is Not Null,"On Hold for Issue",[job_Tracking].[QCCompleteDate] Is Not Null,"QC Complete",[job_Tracking].[AnalystCompleteDate] Is Not Null,"Ready for Review",[job_Tracking].[DateASsigned] Is Not Null,"Assigned",[job_Tracking].[DateAssigned] Is Null,"Not Assigned") AS Status, Job_Tracking.LoanNumber, Job_Tracking.ConsolidatedStatement, Job_Tracking.PropertyNumber, Job_Tracking.ReportingPeriod, TotalSCOPE_TAT.DateAssigned, TotalSCOPE_TAT.RushReqDate, TotalSCOPE_TAT.ResolvedIssueDate, TotalSCOPE_TAT.MaxDate, dateAddNoWeekendsHolidays(Maximum([TotalScope_MaxDate].[DateAssigned],[TotalScope_MaxDate].[RushReqDate],[TotalScope_MaxDate].[ResolvedIssueDate]),[TotalTATTime]) AS DueDate
FROM Job_Tracking INNER JOIN TotalSCOPE_TAT ON (Job_Tracking.ReportingPeriod = TotalSCOPE_TAT.ReportingPeriod) AND (Job_Tracking.LoanNumber = TotalSCOPE_TAT.LoanNumber) AND (Job_Tracking.DateAssigned = TotalSCOPE_TAT.DateAssigned)
WHERE (((Job_Tracking.Withdraw)=0))
GROUP BY Switch([job_Tracking].[Signed Off] Is Not Null,"Signed Off",[job_Tracking].[On hold for Issue] Is Not Null,"On Hold for Issue",[job_Tracking].[QCCompleteDate] Is Not Null,"QC Complete",[job_Tracking].[AnalystCompleteDate] Is Not Null,"Ready for Review",[job_Tracking].[DateASsigned] Is Not Null,"Assigned",[job_Tracking].[DateAssigned] Is Null,"Not Assigned"), Job_Tracking.LoanNumber, Job_Tracking.ConsolidatedStatement, Job_Tracking.PropertyNumber, Job_Tracking.ReportingPeriod, TotalSCOPE_TAT.DateAssigned, TotalSCOPE_TAT.RushReqDate, TotalSCOPE_TAT.ResolvedIssueDate, TotalSCOPE_TAT.MaxDate, dateAddNoWeekendsHolidays(Maximum([TotalScope_MaxDate].[DateAssigned],[TotalScope_MaxDate].[RushReqDate],[TotalScope_MaxDate].[ResolvedIssueDate]),[TotalTATTime])
HAVING (((Job_Tracking.ReportingPeriod)<"2020*"));

Thank you very much again