Option Compare Database
Option Explicit

Dim db As DAO.Database
Dim rst(1 To 6) As DAO.Recordset
Dim strDocName As String, strFN As String, strKType As String, strForm As String
Dim strSQL As String, strCompID As String, strUserID As String, strID As String
Dim strComments As String, strEmpID As String, strEventTitle As String
Dim strFindEmpID As String, strMsg As String, strK_ID As String, strEmpName As String
Dim lngRecID As Long, lngAwardID As Long, lngPType As Long, lngErrNum As Long, lngID As Long
Dim lngAward As Long, lngPromoID As Long
Dim intOpt As Integer, ansMsgBox As Integer, intCount As Integer, intMax As Integer
Dim intLastAwardSeq As Integer, intMaxQtyPer As Integer, intQtyAvail As Integer, intMaxSetSeq As Integer
Dim intMaxSeq As Integer, intLastSeq As Integer, intNextSeq As Integer, intSetID As Integer
Dim dteDate As Date
Dim blnPromo As Boolean

Private Sub Form_Activate()
    DoCmd.Maximize
End Sub

Private Sub Form_Open(Cancel As Integer)
    DoCmd.Maximize

    strCompID = MachName()

    DoCmd.SetWarnings False

        strSQL = "DELETE * FROM TempEntry WHERE CompID='" & strCompID & "';"
        DoCmd.RunSQL strSQL

        strSQL = "UPDATE KaizenHdr SET KaizenHdr.Mark = False WHERE MarkCompID='" & strCompID & "';"
        DoCmd.RunSQL strSQL

    DoCmd.SetWarnings True

    TempEntry_Subform.Requery
    optCloseGrantAwards.Enabled = False
    optCloseNoAwards.Enabled = False
End Sub

Private Sub ExitApp_Click()
On Error GoTo Err_ExitApp_Click
    DoCmd.Quit
Exit_ExitApp_Click:
    Exit Sub
Err_ExitApp_Click:
    MsgBox Err.Description
    Resume Exit_ExitApp_Click
End Sub

Private Sub Form_Unload(Cancel As Integer)
    strCompID = MachName()

    DoCmd.SetWarnings False

        strSQL = "UPDATE KaizenHdr SET KaizenHdr.Mark = False WHERE MarkCompID='" & strCompID & "';"
        DoCmd.RunSQL strSQL

    DoCmd.SetWarnings True
End Sub

Private Sub GenerateReport_Click()
    On Error GoTo ErrHandler

    Dim db As DAO.Database
    Dim rst(1 To 2) As DAO.Recordset
    Dim sList As String
    Dim numRecs As Long
    Dim fOpened_rst(1 To 2) As Boolean
    Dim idx As Long

    Set db = CurrentDb

    numRecs = KaizenHdr_subform.Form.DSSelHeight

    MsgBox numRecs

    strCompID = MachName()

    DoCmd.SetWarnings False

        strSQL = "DELETE * FROM TempReport WHERE CompID='" & strCompID & "';"
        DoCmd.RunSQL strSQL

    DoCmd.SetWarnings True

    Set rst(1) = KaizenHdr_subform.Form.RecordsetClone
    fOpened_rst(1) = True

    strSQL = "SELECT * FROM TempReport;"
    Set rst(2) = db.OpenRecordset(strSQL, dbOpenDynaset)

    fOpened_rst(2) = True

    For idx = 1 To numRecs
        sList = sList & KaizenHdr_subform.Form.RecID.Value & vbCrLf

        If (Not (rst(1).EOF)) Then
            KaizenHdr_subform.Form.Bookmark = rst(1).Bookmark
            With rst(2)
                .AddNew
                    !RecID = KaizenHdr_subform.Form.RecID.Value
                    !CompID = strCompID
                .Update
            End With
            rst(1).MoveNext
            KaizenHdr_subform.Form.Bookmark = rst(1).Bookmark
        End If
    Next idx

CleanUp:

    If (fOpened_rst(1)) Then
        rst(1).Close
        Set rst(1) = Nothing
        fOpened_rst(1) = False
    End If

    If (fOpened_rst(2)) Then
        rst(2).Close
        Set rst(2) = Nothing
        fOpened_rst(2) = False
    End If

    Set rst(1) = Nothing
    Set rst(2) = Nothing
    numRecs = 0

    Exit Sub

ErrHandler:
    MsgBox "Error in GenerateReport_Click() in" & vbCrLf & _
        Me.Name & " form." & vbCrLf & vbCrLf & _
        "Error #" & Err.Number & vbCrLf & vbCrLf & Err.Description
    Err.Clear

    GoTo CleanUp
End Sub

Private Sub GoToMainMenu_Click()
On Error GoTo Err_GoToMainMenu_Click

    strFN = Me.Name

    strDocName = "MainMenu"
    DoCmd.OpenForm strDocName

    DoCmd.Close acForm, strFN

Exit_GoToMainMenu_Click:
    Exit Sub
Err_GoToMainMenu_Click:
    MsgBox Err.Description
    Resume Exit_GoToMainMenu_Click
End Sub

Private Sub AddRecord_Click()
On Error GoTo Err_AddRecord_Click
    Dim intTotalAvail As Integer, intBalAvail As Integer

    Set db = CurrentDb

    strCompID = MachName()
    strUserID = UserID()

    strSQL = "SELECT TempEntry.EmpID FROM TempEntry WHERE (((TempEntry.CompID)='" & strCompID & "'));"
    Set rst(1) = db.OpenRecordset(strSQL, dbReadOnly)

    If rst(1).RecordCount = 0 Then
        MsgBox "You have not entered any participants for this record!!!", vbCritical, "Add Record Aborted - No Participants"
        GoTo MissingData
    End If

    dteDate = DateValue(KaizenDate1.Value)
    strKType = Nz(KaizenType1, "NA")
    lngPType = Nz(ProjectType1, -1)
    strEmpID = Nz(TeamLeader, "000000")
    strEventTitle = Nz(Trim(EventTitle), "NA")
    strComments = Left(Nz(Trim(Comments), ""), 255)

    If strKType = "NA" Then
        MsgBox "Please Enter Kaizen Type", vbExclamation, "Missing Kaizen Type"
        KaizenType1.SetFocus
        GoTo MissingData
    End If

    If lngPType = -1 Then
        MsgBox "Please Enter Project Type", vbExclamation, "Missing Project Type"
        ProjectType1.SetFocus
        GoTo MissingData
    End If

    Select Case strKType

        Case "E"
            If strEmpID = "000000" Then
                MsgBox "Please Enter Team Leader", vbExclamation, "Missing Team Leader"
                TeamLeader.SetFocus
                GoTo MissingData
            End If
            If strEventTitle = "NA" Then
                MsgBox "Please Enter Event Title", vbExclamation, "Missing Event Title"
                EventTitle.SetFocus
                GoTo MissingData
            End If
        Case "I"
            strEmpID = "000000"

    End Select

    strSQL = "SELECT K_ID, K_Date, K_Type, ProjectType, TeamLeader, EventTitle, Comments, UserID, CompID, Status FROM KaizenHdr;"
    Set rst(2) = db.OpenRecordset(strSQL, dbOpenDynaset)

    strID = NextID(strKType)

    With rst(2)
        .AddNew
            !K_ID = strID
            !K_Date = dteDate
            !K_Type = strKType
            !TeamLeader = strEmpID
            !EventTitle = strEventTitle
                If strKType = "E" Then
                    !Status = 1
                ElseIf strKType = "I" Then
                    !Status = 2
                End If
            !ProjectType = lngPType
            !Comments = strComments
            !UserID = strUserID
            !CompID = strCompID
        .Update
    End With

    lngRecID = DLookup("[RecID]", "KaizenHdr", "K_ID = '" & strID & "'")

    strSQL = "SELECT RecID, EmpID FROM KaizenParticipants;"
    Set rst(3) = db.OpenRecordset(strSQL, dbOpenDynaset)

    rst(1).MoveFirst

    Do
        With rst(3)
            .AddNew
                !RecID = lngRecID
                !EmpID = rst(1)!EmpID
            .Update
        End With

        rst(1).MoveNext
    Loop While Not rst(1).EOF

''  Award Promo

    blnPromo = Promo

    If blnPromo = True Then
        If PromoAward.ListIndex = -1 Then
            MsgBox "Please select Promo Award!", vbExclamation, "Promo Award Not Selected"
            GoTo MissingData
        End If
        lngPromoID = PromoAward
        intTotalAvail = DLookup("[QtyAvail]", "Awards", "[AwardID]=" & lngPromoID)
        intBalAvail = intTotalAvail - Nz(DCount("[Award]", "KaizenAwards", "[Award]=" & lngPromoID), 0)
        intMaxQtyPer = DLookup("[MaxQtyPer]", "Awards", "[AwardID]=" & lngPromoID)
    End If

    strSQL = "SELECT KaizenParticipants.ID, KaizenParticipants.EmpID FROM KaizenHdr INNER JOIN " _
        & "KaizenParticipants ON KaizenHdr.RecID = KaizenParticipants.RecID WHERE (((KaizenHdr.K_ID)='" & strID & "')) " _
        & "ORDER BY KaizenParticipants.EmpID;"
    Set rst(4) = db.OpenRecordset(strSQL, dbOpenSnapshot)

    strSQL = "SELECT ID, Award, AwardDate, Points, Comments FROM KaizenAwards;"
    Set rst(5) = db.OpenRecordset(strSQL, dbOpenDynaset)

    rst(4).MoveFirst

    Do
        strEmpID = rst(4)!EmpID

        ''  Modified 6/1/2016
        ''  Determin last award sequence for employee and K_Type
        intLastSeq = LastAwardSeq(strEmpID, strKType)
        ''  Determine SetID
        intSetID = GetSetID(strKType, intLastSeq)
        ''  Determine maximum sequence number for award type and SetID
        intMaxSetSeq = GetMaxSetSeq(strKType, intSetID)

        If intLastSeq < 0 Then intLastSeq = 0

        lngAwardID = 0

        If intLastSeq = intMaxSetSeq Then

            If strKType = "I" Then
                ''  Check if Event set is not complete for current SetID
                If CheckEventSetComplete(strEmpID, intSetID) = False Then
                    ''  Event set is not complete for SetID
                    lngAwardID = 1001 'Implemented set complete
                    intNextSeq = 0
                    'Debug.Print strEmpID & " - " & "A"
                Else
                    If intLastSeq = MaxSeq_K_Type(strKType) Then
                        ''  All current Implemeted awards have been issued
                        lngAwardID = 1001 'Implemented set complete
                        intNextSeq = 0
                        'Debug.Print strEmpID & " - " & "B"
                    Else
                        ''  Event set is complete for SetID then award next implemented tool
                        intNextSeq = intLastSeq + 1
                        'Debug.Print strEmpID & " - " & "C"
                    End If
                End If
            ElseIf strKType = "E" Then
                intNextSeq = intLastSeq + 1
                'Debug.Print strEmpID & " - " & "D"
            End If

        Else
            If strKType = "I" Then
                intNextSeq = intLastSeq + 1
                'Debug.Print strEmpID & " - " & "E"
            ElseIf strKType = "E" Then
                intNextSeq = intLastSeq + 1
                'Debug.Print strEmpID & " - " & "F"
            End If

        End If

        If strKType = "E" Then GoTo PromoGone

        strSQL = "SELECT AwardID, K_Type, Seq FROM Awards WHERE Inactive=False AND K_Type='" & strKType & "' AND Seq=" & intNextSeq & ";"
        Set rst(6) = db.OpenRecordset(strSQL, dbOpenSnapshot)

        rst(6).MoveFirst

'' Award Promo if needed

        If blnPromo = True Then
            ''  Checks if employee has reached Promo Max Limit
            intBalAvail = intTotalAvail - Nz(DCount("[Award]", "KaizenAwards", "[Award]=" & lngPromoID), 0)

            If intBalAvail <= 0 Then
                MsgBox "Promo Supply has been exhausted!", vbExclamation, "Promo Complete"
                Promo = False
                PromoAward = ""
                GoTo PromoGone
            End If

            If Nz(DLookup("[PromoCount]", "PromoCountByEmpID", "[EmpID]='" & strEmpID & "'"), 0) < intMaxQtyPer Then
                If Left(strEmpID, 1) = "X" Then
                    ' Do nothing
                Else
                    With rst(5)
                        rst(5).AddNew
                            !ID = rst(4)!ID
                            !Award = lngPromoID
                            !AwardDate = Now()
                        rst(5).Update
                    End With
                End If
            End If
        End If

PromoGone:

        Do
            With rst(5)

                If strKType = "E" Then
                    rst(5).AddNew
                        rst(5)!ID = rst(4)!ID

                        If Left(strEmpID, 1) = "X" Then
                            rst(5)!Award = 1005
                        Else
                            rst(5)!Award = 1003
                        End If

                        rst(5).Update
                    GoTo NoAward
                End If

                rst(5).AddNew
                    !ID = rst(4)!ID
                    If strKType = "I" Then
                        If lngAwardID = 0 Then
                            If Left(strEmpID, 1) = "X" Then
                                rst(5)!Award = 1005
                            Else
                                !Award = rst(6)!AwardID
                            End If
                            !AwardDate = Now()
                        ElseIf lngAwardID = 1001 Then
                            'Implemented set complete
                            !Award = lngAwardID
                            !Points = 1
                            !AwardDate = Now()
                        End If
                    End If
                rst(5).Update
            End With

            rst(6).MoveNext
        Loop While Not rst(6).EOF
NoAward:
        rst(4).MoveNext
    Loop While Not rst(4).EOF

EventType:

    DoCmd.SetWarnings False
        strSQL = "DELETE * FROM TempEntry WHERE CompID='" & strCompID & "';"
        DoCmd.RunSQL strSQL
    DoCmd.SetWarnings True

    TempEntry_Subform.Requery
    ProjectType1 = ""
    TeamLeader = ""
    EventTitle = ""

    MsgBox "Record ID: " & strID & " has been added!!!", vbInformation, "Add Record Confirmation"

    KaizenHdr_subform.Requery
    KaizenDate1.SetFocus
    PromoDetail.Requery

MissingData:
    Set rst(1) = Nothing
    Set rst(2) = Nothing
    Set rst(3) = Nothing
    Set rst(4) = Nothing
    Set rst(5) = Nothing
    Set rst(6) = Nothing
    Set db = Nothing

Exit_AddRecord_Click:
    Exit Sub
Err_AddRecord_Click:
    lngErrNum = Err.Number

    Select Case lngErrNum
        Case Else
            MsgBox "lngErrNum: " & lngErrNum & vbCrLf & "ErrDesc: " & Err.Description, vbCritical, "Error In AddRecord Module"
            Resume Exit_AddRecord_Click
    End Select
End Sub

Private Sub KaizenType1_AfterUpdate()

    strKType = KaizenType1

    Select Case strKType

        Case "E"
            lblKaizenHdr_subform.Caption = "Kaizen Events"
            optCloseGrantAwards.Enabled = True
            optCloseNoAwards.Enabled = True
            TeamLeader.Enabled = True
            EventTitle.Enabled = True
            Promo = False
            Promo.Enabled = False
            PromoAward = ""
            PromoAward.Enabled = False
        Case "I"
            lblKaizenHdr_subform.Caption = "Kaizen Implemented"
            optCloseGrantAwards.Enabled = False
            optCloseNoAwards.Enabled = False
            TeamLeader = ""
            TeamLeader.Enabled = False
            EventTitle = Null
            EventTitle.Enabled = False
            Promo.Enabled = True
            PromoAward.Enabled = True
        Case "S"

    End Select

    Call ClearMarked

    KaizenHdr_subform.Requery
    SelectPartAwards.Requery
End Sub

Private Sub optMenu_AfterUpdate()

    intOpt = optMenu.Value
    optMenu.Value = 0

    strCompID = MachName()
    intCount = DCount("[Mark]", "KaizenHdr", "[MarkCompID]='" & strCompID & "'")

    If intCount = 0 Then Exit Sub

    Select Case intOpt
        Case 1 'Award Summary Report
            If CheckPrinter = False Then
                MsgBox "Your Current Default Printer is NOT capable of " _
                    & vbCrLf & "Printing or Previewing the Award Summary Report!!!" & vbCrLf & vbCrLf _
                    & "Please select a different default printer.", vbExclamation, "Windows Default Printer Alert"
                Exit Sub
            End If
            strDocName = "AwardSummaryReport"
            DoCmd.OpenReport strDocName, acPreview
        Case 2 'Close Event - Grant Awards
            ansMsgBox = MsgBox("Are you sure you want to Close Event and Grant Awards?", vbYesNo, "Confirm Close Event/Grant Awards")
            If ansMsgBox = vbNo Then Exit Sub
            Call CloseEvent
            ansMsgBox = MsgBox("Would you like to clear the records that you had marked?", vbYesNo, "Confirm Clear Marked Records")
            If ansMsgBox = vbYes Then Call ClearMarked
        Case 3 'Print Labels for Tool Distribution
            Call PrintAll
            ansMsgBox = MsgBox("Would you like to clear the records that you had marked?", vbYesNo, "Confirm Clear Marked Records")
            If ansMsgBox = vbYes Then Call ClearMarked
        Case 4 'Close Event - No Awards
            ansMsgBox = MsgBox("Are you sure you want to Close Event Without Granting Awards?", vbYesNo, "Confirm Close Event/DO NOT Grant Awards")
            If ansMsgBox = vbNo Then Exit Sub
            Call CloseEvent
            ansMsgBox = MsgBox("Would you like to clear the records that you had marked?", vbYesNo, "Confirm Clear Marked Records")
            If ansMsgBox = vbYes Then Call ClearMarked
    End Select

End Sub

'Private Sub PrintAwardLabels_Click()
'On Error GoTo Err_PrintAwardLabels_Click

'    Dim strDocName As String

'    strDocName = "AwardSummaryReport"
 '   DoCmd.OpenReport strDocName, acNormal

'Exit_PrintAwardLabels_Click:
'    Exit Sub

'Err_PrintAwardLabels_Click:
'    MsgBox Err.Description
'    Resume Exit_PrintAwardLabels_Click

'End Sub

Sub ClearMarked()
    strCompID = MachName()

    DoCmd.SetWarnings False
        strSQL = "UPDATE KaizenHdr SET KaizenHdr.Mark = False, KaizenHdr.MarkCompID = Null WHERE (((KaizenHdr.MarkCompID)='" & strCompID & "'));"
        DoCmd.RunSQL strSQL
    DoCmd.SetWarnings True

    Me.KaizenHdr_subform.Requery
End Sub

Private Sub ProjectType1_KeyDown(KeyCode As Integer, Shift As Integer)
    ProjectType1.Dropdown
End Sub

Private Sub Promo_AfterUpdate()
    If Promo = False Then
        PromoAward = ""
        PromoAward.Enabled = False
        PromoDetail.Requery
        PromoDetail.Enabled = False
    End If
    If Promo = True Then
        PromoAward.Enabled = True
        PromoDetail.Enabled = True
    End If
End Sub

Private Sub PromoAward_AfterUpdate()
    PromoDetail.Requery
End Sub

Private Sub TeamLeader_AfterUpdate()
    strEmpID = Nz(TeamLeader, "NA")
    strCompID = MachName()

    DoCmd.SetWarnings False
        strSQL = "DELETE * FROM TempEntry WHERE CompID='" & strCompID & "' AND Leader=True;"
        DoCmd.RunSQL strSQL
        If strEmpID = "NA" Then GoTo 1
        strSQL = "INSERT INTO TempEntry ( EmpID, CompID, Leader ) SELECT '" & strEmpID & "', '" & strCompID & "', True;"
    DoCmd.RunSQL strSQL
1
    DoCmd.SetWarnings True

    TempEntry_Subform.Requery
End Sub

Private Sub TeamLeader_KeyDown(KeyCode As Integer, Shift As Integer)
    TeamLeader.Dropdown
End Sub

Private Sub AddAttendee_Click()
On Error GoTo Err_AddAttendee_Click

    strForm = "AddNewEmployee"
    DoCmd.OpenForm strForm

Exit_AddAttendee_Click:
    Exit Sub
Err_AddAttendee_Click:
    MsgBox Err.Description
    Resume Exit_AddAttendee_Click
End Sub

Function CloseEvent()
    On Error GoTo Err_CloseEvent
    ''  This process assumes that there will only be 1 Award for each sequence when Event "E" is the K_Type

    Set db = CurrentDb

    strCompID = MachName()

    ''  Modified 6/2/2016
    intMax = MaxSeq_K_Type("E")
    '' Modified 6/18/2015 to exclude terminated employees
    strSQL = "SELECT KaizenHdr.RecID, KaizenParticipants.ID, KaizenParticipants.EmpID, KaizenHdr.Status " _
        & "FROM Employees INNER JOIN (KaizenHdr INNER JOIN KaizenParticipants ON KaizenHdr.RecID = " _
        & "KaizenParticipants.RecID) ON Employees.EmpID = KaizenParticipants.EmpID WHERE (((KaizenHdr.Status)=1) " _
        & "AND ((KaizenHdr.Mark)=True) AND ((KaizenHdr.MarkCompID)=MachName()) AND ((Employees.Status)<>'T'));"
    Set rst(1) = db.OpenRecordset(strSQL, dbOpenSnapshot)

    If rst(1).RecordCount = 0 Then
        MsgBox "You have not selected any records or the Status of the records selected = Closed", vbExclamation, "No Valid Records Selected"
        Set rst(1) = Nothing
        Set db = Nothing
        Exit Function
    End If

    strSQL = "SELECT KaizenHdr.K_ID, KaizenHdr.RecID, KaizenParticipants.ID, Employees.EmpName, " _
        & "KaizenHdr.Status, Employees.Status FROM KaizenHdr INNER JOIN (Employees INNER JOIN KaizenParticipants " _
        & "ON Employees.EmpID = KaizenParticipants.EmpID) ON KaizenHdr.RecID = KaizenParticipants.RecID " _
        & "WHERE (((KaizenHdr.Mark)=True) AND ((KaizenHdr.MarkCompID)= MachName())) " _
        & "GROUP BY KaizenHdr.K_ID, KaizenHdr.RecID, KaizenParticipants.ID, Employees.EmpName, " _
        & "KaizenHdr.Status, Employees.Status HAVING (((KaizenHdr.Status)=1) AND ((Employees.Status)='T'));"
    Set rst(3) = db.OpenRecordset(strSQL, dbOpenSnapshot)

    If rst(3).RecordCount > 0 Then

        DoCmd.SetWarnings False

        strSQL = "UPDATE (Employees INNER JOIN (KaizenHdr INNER JOIN KaizenParticipants ON KaizenHdr.RecID = " _
            & "KaizenParticipants.RecID) ON Employees.EmpID = KaizenParticipants.EmpID) INNER JOIN KaizenAwards " _
            & "ON KaizenParticipants.ID = KaizenAwards.ID SET KaizenAwards.Award = 1006, AwardDate = Date() WHERE " _
            & "(((KaizenHdr.Status)=1) AND ((KaizenHdr.Mark)=True) AND ((KaizenHdr.MarkCompID)= MachName()) AND " _
            & "((Employees.Status)='T'));"
        DoCmd.RunSQL strSQL

        DoCmd.SetWarnings True

    End If

    With rst(1)
        .MoveFirst

        Do
            .MoveNext
        Loop While Not .EOF

    End With

    With rst(1)
        rst(1).MoveFirst

        Do
            lngRecID = rst(1)!RecID
            lngID = rst(1)!ID
            strEmpID = rst(1)!EmpID

            ''  Get last award for current record Employee
            strSQL = "SELECT Awards.K_Type, Max(Awards.Seq) AS MaxOfSeq FROM KaizenParticipants INNER JOIN " _
                & "(Awards INNER JOIN KaizenAwards ON Awards.AwardID = KaizenAwards.Award) ON KaizenParticipants.ID = " _
                & "KaizenAwards.ID WHERE (((KaizenParticipants.EmpID)='" & strEmpID & "')) GROUP BY Awards.K_Type HAVING " _
                & "(((Awards.K_Type)='E'));"
            Set rst(2) = db.OpenRecordset(strSQL, dbOpenDynaset)

            If Left(strEmpID, 1) = "X" Then
                lngAward = 1005
                GoTo FirstAward
            End If

            If rst(2).RecordCount = 0 Then
                lngAward = DLookup("[AwardID]", "Awards", "[Seq]= 1 AND [K_Type]='E' AND [Inactive]= False")
                GoTo FirstAward
            End If

            rst(2).MoveFirst

            ''  Determine last award granted
            intLastAwardSeq = Nz(rst(2)!MaxOfSeq, 0)

            ''  Determine next award to grant
            If intLastAwardSeq >= MaxSeq_K_Type("E") Then
                lngAward = 1002
            Else
                lngAward = DLookup("[AwardID]", "Awards", "[Seq]=" & intLastAwardSeq + 1 & " AND [K_Type]='E' AND [Inactive]= False")
            End If

FirstAward:

            DoCmd.SetWarnings False

            If intOpt = 2 Then ''   Close and Grant Awards

                strSQL = "UPDATE KaizenHdr SET KaizenHdr.Status = 2 WHERE (((KaizenHdr.RecID)=" & lngRecID & "));"
                DoCmd.RunSQL strSQL

                strSQL = "UPDATE KaizenAwards SET KaizenAwards.Award =" & lngAward & ", KaizenAwards.AwardDate = Now() " _
                    & "WHERE (((KaizenAwards.ID)=" & lngID & "));"
                DoCmd.RunSQL strSQL
            ElseIf intOpt = 4 Then ''   Close DO NOT Grant Awards
                lngAward = 1004

                strSQL = "UPDATE KaizenHdr SET KaizenHdr.Status = 3 WHERE (((KaizenHdr.RecID)=" & lngRecID & "));"
                DoCmd.RunSQL strSQL

                strSQL = "UPDATE KaizenAwards SET KaizenAwards.Award =" & lngAward & ", KaizenAwards.AwardDate = Now() " _
                    & "WHERE (((KaizenAwards.ID)=" & lngID & "));"
                DoCmd.RunSQL strSQL
            End If

            DoCmd.SetWarnings True

            rst(1).MoveNext
        Loop Until rst(1).EOF

    End With

    KaizenHdr_subform.Requery
    SelectPartAwards.Requery

Exit_CloseEvent:
    Set rst(1) = Nothing
    Set rst(2) = Nothing
    Set rst(3) = Nothing
    Set db = Nothing

    Exit Function
Err_CloseEvent:
    lngErrNum = Err.Number

    Select Case lngErrNum
        Case Else
            MsgBox "ErrNum: " & lngErrNum & vbCrLf & "ErrDesc: " & Err.Description, vbCritical, "Error In AddRecord Module"
            Resume Exit_CloseEvent
    End Select
End Function