Looking at dates and updating records in table

Access 2010 vba
vba routine needed.

What I have:
Table - called "MyData"
Fields-  "Record_ID" ,  "Status" , "Open_Date",  "Closed_Date"

What I need:

I need a routine that will look at the table("MyData" )  for a ("Status" =  "In_Progress") and ("Closed_Date" = "")
Then take the "Open_Date" value and check to see if it is 10 workings or more old.

If it is
I need to change the "Status" for that record to  "Closed"
AND
ADD A value to ("Closed_Date" = Now() )


Thanks
fordraiders
LVL 3
FordraidersAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Paul Cook-GilesSenior Application DeveloperCommented:
To do this, you'll need a custom function to count the number of working days between two dates:

Public Function WorkDays(varStartDt As Variant, varEndDt As Variant) As Variant
'CALCULATES NUMBER OF WORKDAYS (EXCLUDING HOLIDAYS AND WEEKEND DAYS) BETWEEN TWO DATES
'this function requires the existence and maintenance of HolidayTb.HolidayNa and .HolidayDt
'2/9/04  PDG Initial Development
'20091113 PCG rebuilt to return Null if one or two variables are not entered.

If IsNull(varStartDt) Or IsNull(varEndDt) Then
    WorkDays = Null
Else
  Dim DiffCounter As Long, HolidaysCount As Long, CurrDateValue As Date
      DiffCounter = 0
      CurrDateValue = varStartDt
      
'HolidaysCount = DCount("HolidayNa", "HolidayTb", "HolidayDt between #" & varStartDt & "# And #" & varEndDt & "#")
''loop starts here
    Do While CurrDateValue < varEndDt
    CurrDateValue = CurrDateValue + 1
    If Weekday(CurrDateValue) >= 2 And Weekday(CurrDateValue) <= 6 Then DiffCounter = DiffCounter + 1
        Loop

    WorkDays = (DiffCounter - HolidaysCount)
End If

End Function

Open in new window


This function can also exclude holidays from the count, if you create a HolidayTb with two fields:  HolidayNa (text) and HolidayDt (date), and keep it populated.  You'll also need to uncomment the HolidaysCount line.

Now that you have a way of counting working days, you can create a recordset (using the criteria you defined), check to see how long since each record's Open_Date, and update the records where its been 10 or more working days.  Note that this code assumes that Record_ID is a numeric field.

Public Sub UpdateAgedRecords()
Dim rs As Recordset, db As Database, strSQL As String

strSQL = "Select Record_ID,  Status, Open_Date,  Closed_Date  from MyData where Status = 'In_Progress' and Closed_Date  = ''"
Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL)
   rs.MoveFirst
   Do While rs.EOF = False

'loop through records in rs:
If WorkDays(rs.Fields("Open_Date"), Date) > 9 Then
   DoCmd.RunSQL "Update MyData set Status = 'Closed', Closed_Date = Now() where Record_ID = " & rs.Fields("Record_ID")
End If

rs.MoveNext
Loop
'recordset is closed and emptied:
rs.Close
Set rs = Nothing
End Sub

Open in new window

Gustav BrockCIOCommented:
You just need an update query:

Update 
    MyData
Set
    Status = 'Closed',
    Closed_Date = Now()
Where
    Status = 'In_Progress'
    And
    Closed_Date Is Null
    And
    VDateDiffWorkdays([Open_Date], Date()) >= 10

Open in new window

using the functions here:

Option Explicit

' Common constants.
    
    ' Date.
    ' Workdays per week.
    Public Const WorkDaysPerWeek    As Long = 5
    ' Average count of holidays per week maximum.
    Public Const HolidaysPerWeek    As Long = 1

' Returns the count of full workdays between Date1 and Date2.
' The date difference can be positive, zero, or negative.
' Optionally, if WorkOnHolidays is True, holidays are regarded as workdays.
'
' Note that if one date is in a weekend and the other is not, the reverse
' count will differ by one, because the first date never is included in the count:
'
'   Mo  Tu  We  Th  Fr  Sa  Su      Su  Sa  Fr  Th  We  Tu  Mo
'    0   1   2   3   4   4   4       0   0  -1  -2  -3  -4  -5
'
'   Su  Mo  Tu  We  Th  Fr  Sa      Sa  Fr  Th  We  Tu  Mo  Su
'    0   1   2   3   4   5   5       0  -1  -2  -3  -4  -5  -5
'
'   Sa  Su  Mo  Tu  We  Th  Fr      Fr  Th  We  Tu  Mo  Su  Sa
'    0   0   1   2   3   4   5       0  -1  -2  -3  -4  -4  -4
'
'   Fr  Sa  Su  Mo  Tu  We  Th      Th  We  Tu  Mo  Su  Sa  Fr
'    0   0   0   1   2   3   4       0  -1  -2  -3  -3  -3  -4
'
' Execution time for finding working days of three years is about 4 ms.
'
' Requires table Holiday with list of holidays.
'
' 2015-12-19. Gustav Brock. Cactus Data ApS, CPH.
'
Public Function DateDiffWorkdays( _
    ByVal Date1 As Date, _
    ByVal Date2 As Date, _
    Optional ByVal WorkOnHolidays As Boolean) _
    As Long
    
    Dim Holidays()      As Date
    
    Dim Diff            As Long
    Dim Sign            As Long
    Dim NextHoliday     As Long
    Dim LastHoliday     As Long
    
    Sign = Sgn(DateDiff("d", Date1, Date2))
    If Sign <> 0 Then
        If WorkOnHolidays = True Then
            ' Holidays are workdays.
        Else
            ' Retrieve array with holidays between Date1 and Date2.
            Holidays = GetHolidays(Date1, Date2, False) 'CBool(Sign < 0))
            ' Ignore error when using LBound and UBound on an unassigned array.
            On Error Resume Next
            NextHoliday = LBound(Holidays)
            LastHoliday = UBound(Holidays)
            ' If Err.Number > 0 there are no holidays between Date1 and Date2.
            If Err.Number > 0 Then
                WorkOnHolidays = True
            End If
            On Error GoTo 0
        End If
        
        ' Loop to sum up workdays.
        Do Until DateDiff("d", Date1, Date2) = 0
            Select Case Weekday(Date1)
                Case vbSaturday, vbSunday
                    ' Skip weekend.
                Case Else
                    If WorkOnHolidays = False Then
                        ' Check for holidays to skip.
                        If NextHoliday <= LastHoliday Then
                            ' First, check if NextHoliday hasn't been advanced.
                            If NextHoliday < LastHoliday Then
                                If Sgn(DateDiff("d", Date1, Holidays(NextHoliday))) = -Sign Then
                                    ' Weekend hasn't advanced NextHoliday.
                                    NextHoliday = NextHoliday + 1
                                End If
                            End If
                            ' Then, check if Date1 has reached a holiday.
                            If DateDiff("d", Date1, Holidays(NextHoliday)) = 0 Then
                                ' This Date1 hits a holiday.
                                ' Subtract one day to neutralize the one
                                ' being added at the end of the loop.
                                Diff = Diff - Sign
                                ' Adjust to the next holiday to check.
                                NextHoliday = NextHoliday + 1
                            End If
                        End If
                    End If
                    Diff = Diff + Sign
            End Select
            ' Advance Date1.
            Date1 = DateAdd("d", Sign, Date1)
        Loop
    End If
    
    DateDiffWorkdays = Diff

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


' Returns the count of full workdays between Date1 and Date2.
' The date difference can be positive, zero, or negative.
' Optionally, if WorkOnHolidays is True, holidays are regarded as workdays.
' Returns Null if any parameter is invalid.
'
' Note that if one date is in a weekend and the other is not, the reverse
' count will differ by one, because the first date never is included in the count:
'
'   Mo  Tu  We  Th  Fr  Sa  Su      Su  Sa  Fr  Th  We  Tu  Mo
'    0   1   2   3   4   4   4       0   0  -1  -2  -3  -4  -5
'
'   Su  Mo  Tu  We  Th  Fr  Sa      Sa  Fr  Th  We  Tu  Mo  Su
'    0   1   2   3   4   5   5       0  -1  -2  -3  -4  -5  -5
'
'   Sa  Su  Mo  Tu  We  Th  Fr      Fr  Th  We  Tu  Mo  Su  Sa
'    0   0   1   2   3   4   5       0  -1  -2  -3  -4  -4  -4
'
'   Fr  Sa  Su  Mo  Tu  We  Th      Th  We  Tu  Mo  Su  Sa  Fr
'    0   0   0   1   2   3   4       0  -1  -2  -3  -3  -3  -4
'
' Execution time for finding working days of three years is about 4 ms.
'
' Requires table Holiday with list of holidays.
'
' 2015-12-19. Gustav Brock. Cactus Data ApS, CPH.
'
Public Function VDateDiffWorkdays( _
    ByVal Date1 As Variant, _
    ByVal Date2 As Variant, _
    Optional ByVal WorkOnHolidays As Boolean) _
    As Variant

    Dim Result          As Variant
    
    If IsDate(Date1) And IsDate(Date2) Then
        Result = DateDiffWorkdays(CDate(Date1), CDate(Date2), WorkOnHolidays)
    Else
        Result = Null
    End If
    
    VDateDiffWorkdays = Result

End Function

Open in new window

and a table of holidays.

Code and table can be found in the attached file.
Work.accdb
FordraidersAuthor Commented:
Paul, On your code...starting from today...11/1/2018   your code is updating records 10/17/2018 and up to today
Determine the Perfect Price for Your IT Services

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden with our free interactive tool and use it to determine the right price for your IT services. Download your free eBook now!

FordraidersAuthor Commented:
Is there a way to calculate 10 business days prior to todays date and save that  variable date and the use that in my sql ?

10 business days prior to today would be ?   10/18/2018  and thats my variable ?
FordraidersAuthor Commented:
gustav, I will try your code later tonight..Thanks for the database.
Gustav BrockCIOCommented:
Yes, this function will do that:

' 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.
'
' 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
            Date2 = DateAdd(Interval, MaxDayDiff, Date1)
            ' Retrive array with holidays.
            Holidays = GetHolidays(Date1, Date2)
        End If
        Do Until Days = Number
            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

Open in new window

FordraidersAuthor Commented:
paul, sorry i meant 10/17/2018 up to today...your code is updating records within my 10 day window and it should not.
Paul Cook-GilesSenior Application DeveloperCommented:
>On your code...starting from today...11/1/2018   your code is updating records 11/17/2018 and up to today
I'm sorry, I'm not sure what this means.  :)

>Is there a way to calculate 10 business days prior to todays date and save that  variable date and the use that in my sql ?
>10 business days prior to today would be ?   10/18/2018  and thats my variable ?

You'd need another custom function to do that.  It could use much of the same logic that the WorkDays function does.  Similar to the DateAdd function which comes as part of Access, it would need to accept a Start date and an integer for the number of workdays to be added or subtracted from the Start date.  Do you want to take a stab at building it?  I think it would be valuable experience for you...  :)
FordraidersAuthor Commented:
paul, sorry i meant 10/17/2018 up to today...your code is updating records within my 10 day window and it should not.

but , yes going to step through the code.
Paul Cook-GilesSenior Application DeveloperCommented:
>paul, sorry i meant 10/17/2018 up to today...your code is updating records within my 10 day window and it should not.

Huh.  OK, let's see if we can figure out what's going on.  Put these two lines between lines 10 and 11 of the code
debug.print "ID: " & rs.Fields("Record_ID") & "  ; OpenDt: " &  rs.Fields("Open_Date") 
debug.print "Working days since OpenDt:  " & WorkDays(rs.Fields("Open_Date"), Date) 

Open in new window


and this line after the If WorkDays(rs.Fields("Open_Date"), Date) > 9 Then line:

debug.print "   Updated"

Open in new window


Open the Immediate pane (Control-G), and then run the code;  we should get the two lines for every record in the RS, and "updated" for every line that meets the criteria.
Copy and paste the text from the Immediate pane, and we'll take a look.

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Gustav BrockCIOCommented:
Just use an update query and specifically filter out those days:

Where VDateDiffWorkdays([Open_Date], Date()) >= 10

Open in new window

FordraidersAuthor Commented:
Paul Thanks,
Used  debug.print "Working days since OpenDt:  " & WorkDays(rs.Fields("Open_Date"), Date)   as my variable.

fordraiders
FordraidersAuthor Commented:
Paul , Gustav,  Thank bot of you for very helpful information.

I dont like this new grading system, but i hope both of you get points. !


fordraiders
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Access

From novice to tech pro — start learning today.