Option Compare Database

Sub DATE_OVERLAP()
On Error GoTo GET_err:

Dim db As Database
Dim RS As Recordset
Dim sql As String
Dim B As String
Dim ES As Date
Dim EE As Date
Dim Flg As String


Set db = CurrentDb
DAO.DBEngine.SetOption dbMaxLocksPerFile, 500000
sql = "SELECT * From [rpt_Audit Date Conflict]"
Set RS = db.OpenRecordset(sql)   'Open up the temp tbl just created

             RS.MoveFirst
    With RS

            B = RS.Fields("Badge")
            ES = RS.Fields("Effective Start Date")
            EE = RS.Fields("Effective End Date")
            'Flg = RS.Fields("Overlapping Dates")
            RS.MoveNext

Do Until .EOF
    If B = RS.Fields("Badge") Then
        If RS.Fields("Effective Start Date") < EE - 1 Then
            RS.Edit
                RS.Fields("Overlapping Dates") = "Overlapping Dates"
                RS.Update
    RS.MoveNext
    End If

    Else
            B = RS.Fields("Badge")
            ES = RS.Fields("Effective Start Date")
            EE = RS.Fields("Effective End Date")
            'Flg = RS.Fields("Overlapping Dates")
            RS.MoveNext
    End If


Loop

    End With

    MsgBox "Update Complete"

    Exit Sub


GET_err:
MsgBox Err.Description & Err.Number

End Sub

Sub REPORT_QUARTER()

On Error GoTo GET_err:

    'Declare Variables
    Dim db As Database
    Dim RS As Recordset
    Dim sql As String
    Dim B As String
    Dim SD As Date
    Dim ED As Date
    Dim Flg As String
    Dim RQ As String
    Dim SDQ As Integer
    Dim EDQ As Integer
    Dim CDQ As Integer
    Dim A As String

'Current Database
Set db = CurrentDb
DAO.DBEngine.SetOption dbMaxLocksPerFile, 500000
sql = "SELECT * From [qry_Report Quarter]"

'Open up the temp tbl just created
Set RS = db.OpenRecordset(sql)

RS.MoveFirst

With RS
    'Start Loop
    Do Until .EOF

        'Variables
        B = RS.Fields("Badge")
        SD = RS.Fields("Effective Start Date")
        ED = RS.Fields("Effective End Date")
        SDQ = DatePart("Q", SD)
        EDQ = DatePart("Q", ED)
        CDQ = DatePart("Q", Date)

            'Future Start
            If ED > Date And SD > Date Then
            RS.Edit
            RS.Fields("Reporting Quarter") = "Future Start"
            RS.Update

            'Current Qtr
            ElseIf ED > Date And SD < Date Then
            RS.Edit
            RS.Fields("Reporting Quarter") = "Current Qtr"
            RS.Update

            'Mid Current Quarter End
            ElseIf ED < Now And ED > SD And EDQ = CDQ Then
            RS.Edit
            RS.Fields("Reporting Quarter") = ("Q" & EDQ & "-" & (DatePart("YYYY", ED)))
            RS.Update

            'Previous Quarter
            ElseIf ED < Now And ED > SD And EDQ <> CDQ Then
            RS.Edit
            RS.Fields("Reporting Quarter") = ("Q" & EDQ & "-" & (DatePart("YYYY", ED)))
            RS.Update

            'Same Day
            ElseIf ED < Now And ED = SD And EDQ = CDQ Then
            RS.Edit
            RS.Fields("Reporting Quarter") = ("Q" & EDQ & "-" & (DatePart("YYYY", ED)))
            RS.Update

            'End Date Before Start Date Error
            ElseIf SD > ED Then
            RS.Edit
            RS.Fields("Reporting Quarter") = "Date Logic Error"
            RS.Update

        End If
    RS.MoveNext
    Loop
End With
    MsgBox "Check Complete"
Exit Sub
'End Loop

'On Error
GET_err:
MsgBox Err.Description & Err.Number
End Sub