Solved How do I set next due inspection one year out but with max number of inspections per month? (1 Viewer)

[5hadow]

Hello all,

I want VBA to calculate field next due inspection one year out, but if it lands on a month which already has 3 inspections then I want it to go to next available month short of a year. (Example: if one year out = May which is all booked up, then I want it to check April, and so on until it finds a spot)

So how would I approach this problem? Do I use SQL with grouping?

 

[arnelgp]

if you are saving the Next inspection date to a field, you can Count
the number of inspection for that month/year and if it is greater than 2 then
adjust the month and check again until you find a slot.

dim nxtInspection As Date
nxtInspection = DateAdd("yyyy",1, [last inspection date])
Do Until DCount("1", [tblInspection], "Format$([next inspection date],'yyyymm')='" & Format$(nxtInspection, "yyyymm") & "'") < 3
nxtInspection= DateAdd("m",-1, ntxtInspection)
Loop

 

[5hadow]

if you are saving the Next inspection date to a field, you can Count
the number of inspection for that month/year and if it is greater than 2 then
adjust the month and check again until you find a slot.

dim nxtInspection As Date
nxtInspection = DateAdd("yyyy",1, [last inspection date])
Do Until DCount("1", [tblInspection], "Format$([next inspection date],'yyyymm')='" & Format$(nxtInspection, "yyyymm") & "'") < 3
nxtInspection= DateAdd("m",-1, ntxtInspection)
Loop

Interesting...
In the following line: Do Until DCount("1", [tblInspection], "Format$([next inspection date],'yyyymm')='" & Format$(nxtInspection, "yyyymm") & "'") < 3 , why do you have "1" where DCount string should go instead of field name?

Here's my code so far:

Function MakeSched()
On Error GoTo ErrorHandler
Dim RsMonth As Recordset
Dim RsHP As Recordset
Dim RsLP As Recordset
Dim RsHPOD As Recordset
Dim RsLPOD  As Recordset
Dim LA As Date
Dim strLPOD As String
Dim strMonth As String
Dim strHP As String
Dim strHPOD As String
Dim strLP As String
Dim RsLM As Recordset
Dim strLM As String
Dim intLMID As Long
Dim strOD As String
Dim nxtHPInspection As Date
Dim nxtLPInspection As Date

nxtHPInspection = DateAdd("yyyy", 1, fldIQAdue)
Do Until DCount("fldIQADue", "tblWIUnion", "Format$(fldIQADue,'yyyymm')='" & Format$(nxtHPInspection, "yyyymm") & "'") < 3
nxtHPInspection = DateAdd("m", -1, nxtHPInspection)
Loop

strHP = "SELECT [Work Instructions].*, tblWIUnion.* FROM [Work Instructions] INNER JOIN tblWIUnion ON [Work Instructions].ID = tblWIUnion.fldWIID " & _
"WHERE ((([Work Instructions].PA)='High')) OR (((tblWIUnion.varPriChange)=True))"

strHPOD = "SELECT [Work Instructions].*, tblWIUnion.* FROM [Work Instructions] INNER JOIN tblWIUnion ON [Work Instructions].ID = tblWIUnion.fldWIID " & _
"WHERE ((([Work Instructions].PA)='High') AND (([Work Instructions].LastAudit)<=Date()-365)) OR (((tblWIUnion.varPriChange)=True))"

strLPOD = "SELECT [Work Instructions].*, tblWIUnion.* FROM [Work Instructions] INNER JOIN tblWIUnion ON [Work Instructions].ID = tblWIUnion.fldWIID " & _
"WHERE ((([Work Instructions].PA)='Low') AND (([Work Instructions].LastAudit)<=Date()-365)) OR (((tblWIUnion.varPriChange)=False))"


strLP = "SELECT [Work Instructions].*, tblWIUnion.* FROM [Work Instructions] INNER JOIN tblWIUnion ON [Work Instructions].ID = tblWIUnion.fldWIID " & _
"WHERE ((([Work Instructions].PA)='Low')) AND (((tblWIUnion.varPriChange)=False))"

strMonth = "SELECT tblMonth.ID, fldmonth From tblMonth WHERE (((tblMonth.fldActive)=True))"
strLM = "SELECT * FROM tblWIUnion"

Set db = CurrentDb
Set RsHP = db.OpenRecordset(strHP, dbOpenDynaset)
Set RsLP = db.OpenRecordset(strLP, dbOpenDynaset)
Set RsMonth = db.OpenRecordset(strMonth, dbOpenDynaset)
Set RsLM = db.OpenRecordset(strLM, dbOpenDynaset)
Set RsHPOD = db.OpenRecordset(strHPOD, dbOpenDynaset)
Set RsLPOD = db.OpenRecordset(strLPOD, dbOpenDynaset)
    
    Do While Not RsHP.EOF
    RsHP.Edit
    RsHP!fldIQA = nxtHPInspection
    RsHP.Update
    RsHP.MoveNext
    Loop
    

ErrorHandler:
MsgBox "Error #: " & Err.Number & Err.Description
    End Function

With emphasis on this:

nxtHPInspection = DateAdd("yyyy", 1, fldIQAdue)
Do Until DCount("fldIQADue", "tblWIUnion", "Format$(fldIQADue,'yyyymm')='" & Format$(nxtHPInspection, "yyyymm") & "'") < 3
nxtHPInspection = DateAdd("m", -1, nxtHPInspection)
Loop


    Do While Not RsHP.EOF
    RsHP.Edit
    RsHP!fldIQA = nxtHPInspection
    RsHP.Update
    RsHP.MoveNext
    Loop

All my dates are December, 1900 - lowest possible (I think) which means it's not counting dates correctly.

 

[arnelgp]

it is meant to be made as a function.
it needs date field, the [last inspection date] (or if it has no inspection yet, the date when the equipment was acquired)

 

[5hadow]

it is meant to be made as a function.
it needs date field, the [last inspection date] (or if it has no inspection yet, the date when the equipment was acquired)

Did you mean something like this?:

My function returns a correct date, but RsHP!fldIQA = GetNextDate only comes up with 12:00:00 instead of returning a date. Any ideas?

 

[Gasman]

Nextinspection should be surrounded with # and in mm/dd/yyyy format?

 

[5hadow]

Nextinspection should be surrounded with # and in mm/dd/yyyy format?

Function GetNextDate() As Date
Dim nxtInspection As Date

    strHP = "SELECT [Work Instructions].*, tblWIUnion.* FROM [Work Instructions] INNER JOIN tblWIUnion ON [Work Instructions].ID = tblWIUnion.fldWIID " & _
        "WHERE ((([Work Instructions].PA)='High')) OR (((tblWIUnion.varPriChange)=True))"
    Set db = CurrentDb
    Set RsHP = db.OpenRecordset(strHP, dbOpenDynaset)

    nxtInspection = RsHP!fldIQADue
    Do Until DCount("fldIQADue", "tblWIUnion", "Format$(fldIQADue,'yyyymm')='" & Format$(nxtInspection, "yyyymm") & "'") < 3
    nxtInspection = DateAdd("m", -1, nxtInspection)
    Loop
    GetNextDate = nxtInspection
    Set db = Nothing
    Set RsHP = Nothing
End Function

You're right.

So this now sets all dates to month - 1 regardless of how many there are in each month. Maybe something is up with my loop?

 

[Gasman]

You need to walk through the code with F8 line by line and inspect the variables.?
Your are still not using #

Put that Dcount into an immediate window and see what it produces. I suspect nothing or error ?

 

[Cronk]

So this now sets all dates to month - 1 regardless of how many there are in each month. Maybe something is up with my loop?

Yes, it's the following loop which is replacing all the records with the same date. You need to select the record for the particular item, not all items returned by the query

Do While Not RsHP.EOF
    RsHP.Edit
    RsHP!fldIQA = nxtHPInspection
    RsHP.Update
    RsHP.MoveNext
Loop

Incidentally, what happens if there are 3 inspections in each of the 12 succeeding months? Without a check for this, you will set the next inspection date some time in the past.

 

[5hadow]

I've got the code to do what I want it to do, but I need to add more loops.
When I add another loop right after another, I get the error 3420 "Object Invalid or no longer set" on "Do While Not rstLP.EOF" line

Function MakeSched()
Dim db As DAO.Database
Dim rstHP As DAO.Recordset
Dim rstLP As DAO.Recordset
Dim rstHPOD As DAO.Recordset
Dim rstLPOD  As DAO.Recordset
Dim rstLM As DAO.Recordset
Dim strLPOD As String
Dim strMonth As String
Dim strHP As String
Dim strHPOD As String
Dim strLP As String
Dim strLM As String

    strHP = "SELECT [Work Instructions].*, tblWIUnion.* FROM [Work Instructions] INNER JOIN tblWIUnion ON [Work Instructions].ID = tblWIUnion.fldWIID " & _
    "WHERE ((([Work Instructions].PA)='High')) OR (((tblWIUnion.varPriChange)=True))"
    
    strHPOD = "SELECT [Work Instructions].*, tblWIUnion.* FROM [Work Instructions] INNER JOIN tblWIUnion ON [Work Instructions].ID = tblWIUnion.fldWIID " & _
    "WHERE ((([Work Instructions].PA)='High') AND (([Work Instructions].LastAudit)<=Date()-365)) OR (((tblWIUnion.varPriChange)=True))"
    
    strLPOD = "SELECT [Work Instructions].*, tblWIUnion.* FROM [Work Instructions] INNER JOIN tblWIUnion ON [Work Instructions].ID = tblWIUnion.fldWIID " & _
    "WHERE ((([Work Instructions].PA)='Low') AND (([Work Instructions].LastAudit)<=Date()-365)) OR (((tblWIUnion.varPriChange)=False))"
    
    
    strLP = "SELECT [Work Instructions].*, tblWIUnion.* FROM [Work Instructions] INNER JOIN tblWIUnion ON [Work Instructions].ID = tblWIUnion.fldWIID " & _
    "WHERE ((([Work Instructions].PA)='Low')) AND (((tblWIUnion.varPriChange)=False))"
    
    strMonth = "SELECT tblMonth.ID, fldmonth From tblMonth WHERE (((tblMonth.fldActive)=True))"
    strLM = "SELECT * FROM tblWIUnion"

    Set db = CurrentDb
    
    Set rstHP = db.OpenRecordset(strHP, dbOpenDynaset)
    Set rstLP = db.OpenRecordset(strLP, dbOpenDynaset)
    Set rstMonth = db.OpenRecordset(strMonth, dbOpenDynaset)
    Set rstLM = db.OpenRecordset(strLM, dbOpenDynaset)
    Set rstHPOD = db.OpenRecordset(strHPOD, dbOpenDynaset)
    Set rstLPOD = db.OpenRecordset(strLPOD, dbOpenDynaset)
    
    Do While Not rstHPOD.EOF
        rstHPOD.Edit
        nxtInspection = rstHPOD!fldIQADue
            Do Until DCount("fldIQA", "tblWIUnion", "Format$(fldIQADue,'yyyymm')='" & Format$(nxtInspection, "yyyymm") & "'") < 3
            nxtInspection = DateAdd("m", -1, nxtInspection)
        Loop
        rstHPOD!fldIQA = nxtInspection
        rstHPOD.Update
        rstHPOD.MoveNext
        rstHPOD.Close
    Loop
    Set rstHPOD = Nothing

    Do While Not rstLP.EOF
        rstLP.Edit
        nxtInspection = rstLP!fldIQADue
            Do Until DCount("fldIQA", "tblWIUnion", "Format$(fldIQADue,'yyyymm')='" & Format$(nxtInspection, "yyyymm") & "'") < 3
            nxtInspection = DateAdd("m", -1, nxtInspection)
        Loop
        rstLP!fldIQA = nxtInspection
        rstLP.Update
        rstLP.MoveNext
        rstLP.Close
    Loop
    Set rstLP = Nothing
    
    
    
    DoCmd.Requery
    'ErrorHandler:
    'MsgBox "Error #: " & Err.Number & Err.Description
End Function

 

[arnelgp]

you are Closing the recordset inside the loop, move it outside the loop.

 

[5hadow]

you are Closing the recordset inside the loop, move it outside the loop.

Thanks so much!

 

[5hadow]

Now that I have this working, my next question is how do I check to see if selected month is active, as in, there is a checkmark next to it from separate subform?

For example with this line of code:

    Do While Not rstLP.EOF
        rstLP.Edit
        nxtInspection = rstLP!fldIQADue
            Do Until DCount("fldIQA", "tblWIUnion", "Format$(fldIQA,'yyyymm')='" & Format$(nxtInspection, "yyyymm") & "'") < 3
            nxtInspection = DateAdd("m", -1, nxtInspection)
        Loop
        rstLP!fldIQA = nxtInspection
        rstLP.Update
        rstLP.MoveNext
    Loop
    rstLP.Close
    Set rstLP = Nothing

Where rstLP!fldIQA = nxtInspection loops trough next inspection dates and finds a month that contains less than 3 inspections, I want to check if this month is also selected in my subform, as in image below:

I have the following ready which ensures my month is one of the selected:
Dim rstMonth As Recordset

Set rstMonth = db.OpenRecordset(strMonth, dbOpenDynaset)


strMonth = "SELECT tblMonth.ID, fldmonth From tblMonth WHERE (((tblMonth.fldActive)=True))"



How do I use this information in code above?