Private Sub CommandButton28_Click()
'// Audit1 Page 4 all departments automated
' listbox items deleted after update leaving only the ones not selected
' Load all the variables from AC sheet depending on Dept
' we now know which line to write back to with value LBAuditP4 and C
' Need to load all the job numbers that have been input on Audit !!!
Dim ws As Worksheet
Dim DIndex As String
Dim c As Integer
Dim I As Integer
Dim listindex As Long
Dim Dept As String
Dim Answer As String
Dim check As String
Dim r As Integer
Dim x As Integer
Dim N As Integer
N = 0: r = 0: c = 0: I = 0: x = 0
Dim cno As Variant
' chk if any selection made 1st
With Me.LBAuditP4
For r = 0 To .ListCount - 1
If .Selected(r) = True Then
x = x + 1
End If
Next r
If x = 0 Then
MsgBox "No Selection, Please Select A Single or Multiple Questions", , "No Selection Audit Questions"
Call Clr_LBAudit
Exit Sub
End If
End With
If x > 1 And OptionButton94.Value = True Then
MsgBox " You Cannot Select No, If Your Selection Is > 1 !", , "No, Not Applicable To Multiple Questions"
For N = 0 To LBAuditP4.ListCount - 1
Me.LBAuditP4.Selected(N) = False
Next N
N = 0
Call Clr_LBAudit
Exit Sub
End If
check = MsgBox("Correct Questions & Audit Compliant ? Then Click YES To Accept or NO to Abort ! ", _
vbYesNo + vbInformation, "Confirmation Of Job Number")
If check = vbNo Then
For N = 0 To LBAuditP4.ListCount - 1
Me.LBAuditP4.Selected(N) = False
Next N
N = 0
Call Clr_LBAudit
Exit Sub
End If
Dept = Me.CboAudDept.Text
' Yes Or No or NA answers here 94 = NO 95 = YES NA = 103 ! updated to include NA 19/10/13
If OptionButton94.Value = True Then Answer = "N"
If OptionButton95.Value = True Then Answer = "Y"
If OptionButton103.Value = True Then Answer = "NA"
'// Get DIndex variable from AudSum sheet so we know which audit sheet its going to
DIndex = Worksheets("AudSum").cells(3, "AW").Value
'// Start writing it back to the appropriate sheet using the DIndex variable
Set ws = Worksheets(DIndex)
With ws
If DIndex = 20 And .cells(52, "K").Value <> "" Then GoTo Final
If .cells(3, "C").Value = "" Then
.cells(3, "C").Value = Me.TxtAudJobNo.Value: .cells(3, "G").Value = Me.TxtAudJobNo.Value
.cells(3, "K").Value = CLng(CDate(Me.TxtAudJCDate.Value)): .cells(3, "K").NumberFormat = "DD/MM/YYYY"
.cells(3, "S").Value = Me.TxtAudLab.Value
.cells(3, "U").Value = Me.TxtAudMat.Value: .cells(3, "X").Value = Me.TxtAudTotal.Value
End If
End With
With Me.LBAuditP4 '**
Select Case (Dept)
Case "Service Reception" ' Write details to DIndex sheet cells start at 6 to 1
For c = 0 To .ListCount - 1
If .Selected(c) Then
Worksheets(DIndex).cells(c + 1 + 5, "K").Value = Answer
Worksheets(DIndex).cells(c + 1 + 5, "L").Value = Worksheets("AC").Range("SRErrCode").cells(c + 1, 4).Value
Worksheets(DIndex).cells(c + 1 + 5, "M").Value = Worksheets("AC").Range("SRErrCode").cells(c + 1, 5).Value
Worksheets(DIndex).cells(c + 1 + 5, "N").Value = Worksheets("AC").Range("SRErrCode").cells(c + 1, 6).Value
Worksheets(DIndex).cells(c + 1 + 5, "O").Value = Worksheets("AC").Range("SRErrCode").cells(c + 1, 7).Value
Worksheets(DIndex).cells(c + 1 + 5, "P").Value = Worksheets("AC").Range("SRErrCode").cells(c + 1, 8).Value
Worksheets(DIndex).cells(c + 1 + 5, "Q").Value = Worksheets("AC").Range("SRErrCode").cells(c + 1, 9).Value
Worksheets(DIndex).cells(c + 1 + 5, "S").Value = Me.TxtAudNotes.Text
End If
Next c
Application.EnableEvents = False
For I = Me.LBAuditP4.ListCount - 1 To 0 Step -1 ' Remove items selected
If .Selected(I) = True Then
.RemoveItem (I) ' LBAuditP4.listindex+1
End If
Next I
Application.EnableEvents = True
Call Clr_LBAudit
If LBAuditP4.ListCount = 0 Then
Me.CboAudDept.Text = "W/Shop Control Pre Repair"
End If
Case "W/Shop Control Pre Repair" ' Write details to DIndex sheet cells start at 13 to 19
For c = 0 To .ListCount - 1
If .Selected(c) = True Then
Worksheets(DIndex).cells(c + 1 + 12, "K").Value = Answer
Worksheets(DIndex).cells(c + 1 + 12, "L").Value = Worksheets("AC").Range("WCPRErrCode").cells(c + 1, 4).Value
Worksheets(DIndex).cells(c + 1 + 12, "M").Value = Worksheets("AC").Range("WCPRErrCode").cells(c + 1, 5).Value
Worksheets(DIndex).cells(c + 1 + 12, "N").Value = Worksheets("AC").Range("WCPRErrCode").cells(c + 1, 6).Value
Worksheets(DIndex).cells(c + 1 + 12, "O").Value = Worksheets("AC").Range("WCPRErrCode").cells(c + 1, 7).Value
Worksheets(DIndex).cells(c + 1 + 12, "P").Value = Worksheets("AC").Range("WCPRErrCode").cells(c + 1, 8).Value
Worksheets(DIndex).cells(c + 1 + 12, "Q").Value = Worksheets("AC").Range("WCPRErrCode").cells(c + 1, 9).Value
Worksheets(DIndex).cells(c + 1 + 12, "S").Value = Me.TxtAudNotes.Text
End If
Next c
Application.EnableEvents = False
For I = Me.LBAuditP4.ListCount - 1 To 0 Step -1 ' Remove items selected
If .Selected(I) = True Then
.RemoveItem (I)
End If
Next I
Application.EnableEvents = True
Call Clr_LBAudit
If LBAuditP4.ListCount = 0 Then
Me.CboAudDept.Text = "Technician"
End If
Case "Technician" ' Write details to DIndex sheet cells start at 21 to 28
For c = 0 To .ListCount - 1
If .Selected(c) = True Then
Worksheets(DIndex).cells(c + 1 + 20, "K").Value = Answer
Worksheets(DIndex).cells(c + 1 + 20, "L").Value = Worksheets("AC").Range("Tech").cells(c + 1, 4).Value
Worksheets(DIndex).cells(c + 1 + 20, "M").Value = Worksheets("AC").Range("Tech").cells(c + 1, 5).Value
Worksheets(DIndex).cells(c + 1 + 20, "N").Value = Worksheets("AC").Range("Tech").cells(c + 1, 6).Value
Worksheets(DIndex).cells(c + 1 + 20, "O").Value = Worksheets("AC").Range("Tech").cells(c + 1, 7).Value
Worksheets(DIndex).cells(c + 1 + 20, "P").Value = Worksheets("AC").Range("Tech").cells(c + 1, 8).Value
Worksheets(DIndex).cells(c + 1 + 20, "Q").Value = Worksheets("AC").Range("Tech").cells(c + 1, 9).Value
Worksheets(DIndex).cells(c + 1 + 20, "S").Value = Me.TxtAudNotes.Text
End If
Next c
Application.EnableEvents = False
For I = Me.LBAuditP4.ListCount - 1 To 0 Step -1 ' Remove items selected
If .Selected(I) = True Then
.RemoveItem (I)
End If
Next I
Application.EnableEvents = True
Call Clr_LBAudit
If LBAuditP4.ListCount = 0 Then
Me.CboAudDept.Text = "Parts"
End If
' Amended here Post wc now after parts 19/10/13
Case "Parts" ' Write details to DIndex sheet cells start at 30 to 35
For c = 0 To .ListCount - 1
If .Selected(c) = True Then
Worksheets(DIndex).cells(c + 1 + 29, "K").Value = Answer
Worksheets(DIndex).cells(c + 1 + 29, "L").Value = Worksheets("AC").Range("Parts").cells(c + 1, 4).Value
Worksheets(DIndex).cells(c + 1 + 29, "M").Value = Worksheets("AC").Range("Parts").cells(c + 1, 5).Value
Worksheets(DIndex).cells(c + 1 + 29, "N").Value = Worksheets("AC").Range("Parts").cells(c + 1, 6).Value
Worksheets(DIndex).cells(c + 1 + 29, "O").Value = Worksheets("AC").Range("Parts").cells(c + 1, 7).Value
Worksheets(DIndex).cells(c + 1 + 29, "P").Value = Worksheets("AC").Range("Parts").cells(c + 1, 8).Value
Worksheets(DIndex).cells(c + 1 + 29, "Q").Value = Worksheets("AC").Range("Parts").cells(c + 1, 9).Value
Worksheets(DIndex).cells(c + 1 + 29, "S").Value = Me.TxtAudNotes.Text
End If
Next c
Application.EnableEvents = False
For I = Me.LBAuditP4.ListCount - 1 To 0 Step -1 ' Remove items selected
If .Selected(I) = True Then
.RemoveItem (I)
End If
Next I
Application.EnableEvents = True
Call Clr_LBAudit
If LBAuditP4.ListCount = 0 Then
Me.CboAudDept.Text = "W/Shop Control Post Repair"
End If
Case "W/Shop Control Post Repair" ' Write details to DIndex sheet cells start at 37 to 45
For c = 0 To .ListCount - 1
If .Selected(c) = True Then
Worksheets(DIndex).cells(c + 1 + 36, "K").Value = Answer
Worksheets(DIndex).cells(c + 1 + 36, "L").Value = Worksheets("AC").Range("WCPOSErrCode").cells(c + 1, 4).Value
Worksheets(DIndex).cells(c + 1 + 36, "M").Value = Worksheets("AC").Range("WCPOSErrCode").cells(c + 1, 5).Value
Worksheets(DIndex).cells(c + 1 + 36, "N").Value = Worksheets("AC").Range("WCPOSErrCode").cells(c + 1, 6).Value
Worksheets(DIndex).cells(c + 1 + 36, "O").Value = Worksheets("AC").Range("WCPOSErrCode").cells(c + 1, 7).Value
Worksheets(DIndex).cells(c + 1 + 36, "P").Value = Worksheets("AC").Range("WCPOSErrCode").cells(c + 1, 8).Value
Worksheets(DIndex).cells(c + 1 + 36, "Q").Value = Worksheets("AC").Range("WCPOSErrCode").cells(c + 1, 9).Value
Worksheets(DIndex).cells(c + 1 + 36, "S").Value = Me.TxtAudNotes.Text
End If
Next c
Application.EnableEvents = False
For I = Me.LBAuditP4.ListCount - 1 To 0 Step -1 ' Remove items selected
If .Selected(I) = True Then
.RemoveItem (I)
End If
Next I
Application.EnableEvents = True
Call Clr_LBAudit
If LBAuditP4.ListCount = 0 Then
Me.CboAudDept.Text = "Warranty Administration"
End If
Case "Warranty Administration" ' Write details to DIndex sheet cells start at 47 to 52
For c = 0 To .ListCount - 1
If .Selected(c) = True Then
Worksheets(DIndex).cells(c + 1 + 46, "K").Value = Answer
Worksheets(DIndex).cells(c + 1 + 46, "L").Value = Worksheets("AC").Range("WarrAdmin").cells(c + 1, 4).Value
Worksheets(DIndex).cells(c + 1 + 46, "M").Value = Worksheets("AC").Range("WarrAdmin").cells(c + 1, 5).Value
Worksheets(DIndex).cells(c + 1 + 46, "N").Value = Worksheets("AC").Range("WarrAdmin").cells(c + 1, 6).Value
Worksheets(DIndex).cells(c + 1 + 46, "O").Value = Worksheets("AC").Range("WarrAdmin").cells(c + 1, 7).Value
Worksheets(DIndex).cells(c + 1 + 46, "P").Value = Worksheets("AC").Range("WarrAdmin").cells(c + 1, 8).Value
Worksheets(DIndex).cells(c + 1 + 46, "Q").Value = Worksheets("AC").Range("WarrAdmin").cells(c + 1, 9).Value
Worksheets(DIndex).cells(c + 1 + 46, "S").Value = Me.TxtAudNotes.Text
End If
Next c
Application.EnableEvents = False
For I = Me.LBAuditP4.ListCount - 1 To 0 Step -1 ' Remove items selected
If .Selected(I) = True Then
.RemoveItem (I)
End If
Next I
Application.EnableEvents = True
If LBAuditP4.ListCount = 0 And DIndex = 20 Then GoTo Final 'page 20 sheet & all questions answered
If LBAuditP4.ListCount = 0 Then 'wrap it up for this job card
check = MsgBox("Audit Complete For This Job Card :" & vbNewLine & _
" Do You Want To Select Another Job Card / Interrupt Audit At This Point ?", _
vbYesNo + vbInformation, "Confirm Another Job Card")
If check = vbYes Then
DIndex = DIndex + 1 ' update to next sheet
Worksheets("AudSum").cells(3, "AW").Value = DIndex
'clear AuditP4 sheet & set back to job number same dealer
Call Clr_LBAudit
Call Clr_P13_Data
Application.EnableEvents = False
Me.CboAudDept = ""
OptionButton92.Enabled = False
OptionButton93.Enabled = False
OptionButton103.Enabled = False
Me.TxtAudJobNo.Enabled = True
Me.TxtAudJobNo.Text = ""
Me.TxtAudJobNo.SetFocus
Application.EnableEvents = True
MsgBox "Please Select The Next Job Card or Suspend Audit At This Point ?", , "Continuation Of Audit Exit"
CommandButton28.Enabled = False
Me.LBAuditP4.Enabled = False
CommandButton8.Enabled = True
Exit Sub
End If ' answer no end here
GoTo Final
End If
End Select
End With
'// This where we need to updates vales on Multipage2 Page 15
'Me.Frame42.Enabled = False
'FrmAudit.MultiPage2.Value = 2
' Call CommandButton42_Click
' Need to do clear up here clear
'Call Clr_LBAudit
Exit Sub
Final:
MsgBox "End Of Audit For This Dealer, Please Complete Claim Values & Debits", , "Proceed To Claim Values & Debits"
FrmAudit.MultiPage2.Value = 2
Call CommandButton42_Click
' Me.MultiPage1.Page12.Visible = True
'Me.MultiPage1.Value = 4
' Me.MultiPage1.Page4.Visible = False
End Sub
Reply With Quote