- Code: Select all
]Attribute VB_Name = "ESEWOInfo"
Option Explicit
Sub NewESEWO(Optional updating As Boolean = False)
On Error GoTo errhand
If CheckFilled(updating) Then
'******************************************************************************************
Dim retVal As Byte
Dim Shift, dZone, employee, injDate, injDesc, injWhere, tAction, dateval, col, safetyData, _
area, zone, tname, injured, sendTo, subject, body, sMatrix As String
dateval = CStr(Sheets("SEWO").Range("M7"))
Dim month1, montha, montharray As Variant
month1 = VBA.Split(dateval, "/", 3)
montharray = Array("_", "January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December")
montha = montharray(CInt(month1(0)))
Dim sewoNum As LongPtr
sewoNum = CLngPtr(Range("N4"))
If VBA.InStr(1, ActiveWorkbook.Name, "SEWO", vbTextCompare) <> 0 Then
ActiveWorkbook.SaveAs _
fileName:="J:\WCM\1.Safety\Forms\ESEWOs\SEWO " & sewoNum
End If
safetyData = "J:\WCM\1.Safety\Safety Data " & Year(Now) & "\WCM Safety Data.xlsm"
sMatrix = "J:\WCM\1.Safety\Safety Data " & Year(Now) & "\S-Matrix Plant Wide.xlsm"
Shift = Workbooks("SEWO " & sewoNum & ".xlsm").Sheets("SEWO").ShiftComB.Text
dZone = Workbooks("SEWO " & sewoNum & ".xlsm").Sheets("SEWO").DeptComB.Text & " " _
& Workbooks("SEWO " & sewoNum & ".xlsm").Sheets("SEWO").ZoneComB.Text
employee = Workbooks("SEWO " & sewoNum & ".xlsm").Sheets("SEWO").Cells(6, 3).Text
injDate = Workbooks("SEWO " & sewoNum & ".xlsm").Sheets("SEWO").Cells(7, 13).Text
injDesc = Workbooks("SEWO " & sewoNum & ".xlsm").Sheets("SEWO").Cells(9, 3).Text
injWhere = Workbooks("SEWO " & sewoNum & ".xlsm").Sheets("SEWO").Cells(12, 3).Text
tAction = Workbooks("SEWO " & sewoNum & ".xlsm").Sheets("SEWO").Cells(9, 14).Text
Dim row1, row2, row3, row4, row5, row6, row7 As Byte
Dim wo As Integer
Dim cb1, cb2 As Boolean
'******************************************************************************************
Application.ScreenUpdating = False
With Sheets("SEWO")
area = .DeptComB.Text
zone = .ZoneComB.Text
tname = .Cells(7, 7).Text
injured = .Cells(6, 3).Text
End With
If Not updating Then
sendTo = "******@******.com; *****@********.com; *******@******.com; *****@******.com" 'keith, al, marge
subject = "SEWO From Department: " & area & " Zone: " & zone
body = "A SEWO has been filled out by " & tname & " For " & injured
retVal = WorkOrderSubs.newMail((sendTo), (subject), (body))
End If
If ActiveWorkbook.Sheets("5 Why").UnsafeConditionOpB Then
wo = MsgBox("You selected 'Unsafe Condition' as your root cause classification, would you like to send a work order to Maintenance?", vbYesNo)
If wo = 6 Then
WorkOrder.show
End If
End If
If Not updating Then
ActiveWindow.DisplayWorkbookTabs = True
Application.DisplayFormulaBar = True
Application.DisplayScrollBars = True
ActiveWindow.DisplayHeadings = True
Sheets("SEWO").UpdateCBut.Enabled = True
Sheets("SEWO").SubmitCBut.Enabled = False
Sheets("SEWO").SaveIncCBut.Enabled = False
With Sheets("SEWO")
.SketchImg.Picture = _
LoadPicture("J:\WCM\1.Safety\Forms\Sketches\" & sewoNum & ".gif")
.EmpSigImg.Picture = _
LoadPicture("J:\WCM\1.Safety\Forms\Signatures\EMP\" & sewoNum & ".gif")
.TLeadSigImg.Picture = _
LoadPicture("J:\WCM\1.Safety\Forms\Signatures\TL\" & sewoNum & ".gif")
.SupSigImg.Picture = _
LoadPicture("J:\WCM\1.Safety\Forms\Signatures\SUP\" & sewoNum & ".gif")
.MgrDeptSigImg.Picture = _
LoadPicture("J:\WCM\1.Safety\Forms\Signatures\MD\" & sewoNum & ".gif")
.SafMgrSigImg.Picture = _
LoadPicture("J:\WCM\1.Safety\Forms\Signatures\SM\" & sewoNum & ".gif")
.PlantMgrSigImg.Picture = _
LoadPicture("J:\WCM\1.Safety\Forms\Signatures\PM\" & sewoNum & ".gif")
End With
With Sheets("Statement")
.InjuredSigImg.Picture = _
LoadPicture("J:\WCM\1.Safety\Forms\Signatures\Statement\" & sewoNum & ".gif")
.WitnessSigImg.Picture = _
LoadPicture("J:\WCM\1.Safety\Forms\Signatures\Witness\" & sewoNum & ".gif")
End With
End If
With Sheets("5 Why")
cb1 = .UnsafeActOpB.Value
cb2 = .UnsafeConditionOpB.Value
End With
With Sheets("SEWO")
row2 = .InjuryComB.ListIndex + 36
Select Case .DeptComB
Case "Other"
Select Case .ZoneComB
Case "Quality"
col = "C"
Case "Shipping"
col = "D"
Case "Maintenance"
col = "E"
End Select
Case "Molding"
Select Case .ZoneComB
Case "1"
col = "F"
Case "2"
col = "G"
Case "3"
col = "H"
End Select
Case "Paint"
Select Case .ZoneComB
Case "1"
col = "I"
End Select
Case "Vac Form"
Select Case .ZoneComB
Case "1"
col = "J"
Case "2"
col = "K"
End Select
Case "Foam"
Select Case .ZoneComB
Case "1"
col = "L"
Case "2"
col = "M"
Case "3"
col = "N"
End Select
Case "IP Assembly"
Select Case .ZoneComB
Case "1"
col = "O"
Case "2"
col = "P"
Case "3"
col = "Q"
Case "4"
col = "R"
Case "5"
col = "S"
Case "6"
col = "T"
End Select
Case "HT SEQ"
Select Case .ZoneComB
Case "1"
col = "U"
Case "2"
col = "V"
Case "3"
col = "W"
End Select
End Select
Select Case .Range("I12")
Case "Head/ Neck"
row1 = 6
Case "Eye"
row1 = 7
Case "Shoulder"
row1 = 8
Case "Upper Arm"
row1 = 9
Case "Elbow/ Forearm"
row1 = 10
Case "Hand/ Finger/ Wrt"
row1 = 11
Case "Lower Back"
row1 = 12
Case "Chest"
row1 = 13
Case "Leg/ Knee"
row1 = 14
Case "Foot/ Ankle"
row1 = 15
Case "Other"
row1 = 16
End Select
If .CompKnowOpB Then 'Competence/ Knowledge
row3 = 54
End If
If .AttBehavOpB Then 'Attitude/ behavior
row3 = 55
End If
If .ManagementOpB Then 'Management
row3 = 56
End If
If .PrecaAttOpB Then 'Precautions/ Attention
row3 = 57
End If
If .PersonalCondOpB Then 'Personal Conditions
row3 = 58
End If
If .ToolsEquipOpB Then 'Tools/ Equipment
row7 = 59
End If
If .ProcSystemsOpB Then 'Procedures/ Systems
row7 = 60
End If
If .FirstAidOpB Then 'First Aid
row5 = 26
End If
If .RecordableOpB Then 'Recordable
row5 = 25
End If
If .LostTimeOpB Then 'Lost Time
row5 = 24
End If
If .NearMissOpB Then 'Near Miss
row5 = 29
End If
End With
With Sheets("5 Why")
If .UnsafeActOpB Then 'Unsafe Act
row4 = 31
End If
If .UnsafeConditionOpB Then 'Unsafe Condition
row6 = 30
End If
End With
If Not updating Then
Workbooks.Open sMatrix, 3
End If
With Workbooks("S-Matrix Plant Wide.xlsm").Sheets(montha)
.Activate
.Range(col & row1) = .Range(col & row1) + 1
.Range(col & row2) = .Range(col & row2) + 1
.Range(col & row3) = .Range(col & row3) + 1
'If cb1 Then
' .Range(col & row4) = .Range(col & row4) + 1
'End If
.Range(col & row5) = .Range(col & row5) + 1
'If cb2 Then
' .Range(col & row6) = .Range(col & row6) + 1
'End If
.Range(col & row7) = .Range(col & row7) + 1
End With
Application.ScreenUpdating = True
Workbooks("SEWO " & sewoNum & ".xlsm").Activate
If Not updating Then
If Workbooks("SEWO " & sewoNum & ".xlsm").Sheets("SEWO").NearMissOpB Then
Workbooks.Open safetyData, 3
With Workbooks("WCM Safety Data.xlsm").Sheets("Near Miss")
.Activate
.Rows("3:3").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
.Range("A3").Formula = "=ROW()-2"
.Range("B3") = Shift
.Range("C3") = employee
.Range("D3") = dZone
.Range("E3") = injDate
.Range("F3") = injDesc
.Range("G3") = injWhere
.Range("H3").Formula = _
"='J:\WCM\1.Safety\Forms\ESEWOs\[SEWO " & sewoNum & ".xlsm]SEWO'!$U$16"
.Range("I3").Formula = _
"='J:\WCM\1.Safety\Forms\ESEWOs\[SEWO " & sewoNum & ".xlsm]SEWO'!$T$4"
End With
End If
If Workbooks("SEWO " & sewoNum & ".xlsm").Sheets("SEWO").LostTimeOpB Then
Workbooks.Open safetyData, 3
With Workbooks("WCM Safety Data.xlsm").Sheets("LTI")
.Activate
.Rows("3:3").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
.Range("A3").Formula = "=ROW()-2"
.Range("B3") = Shift
.Range("C3") = employee
.Range("D3") = dZone
.Range("E3") = injDate
.Range("F3") = injDesc
.Range("G3") = injWhere
.Range("H3").Formula = _
"='J:\WCM\1.Safety\Forms\ESEWOs\[SEWO " & sewoNum & ".xlsm]SEWO'!$U$16"
.Range("I3").Formula = _
"='J:\WCM\1.Safety\Forms\ESEWOs\[SEWO " & sewoNum & ".xlsm]SEWO'!$T$4"
End With
End If
If Workbooks("SEWO " & sewoNum & ".xlsm").Sheets("SEWO").RecordableOpB Then
Workbooks.Open safetyData, 3
With Workbooks("WCM Safety Data.xlsm").Sheets("Recordables")
.Activate
Rows("3:3").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
.Range("A3").Formula = "=ROW()-2"
.Range("B3") = Shift
.Range("C3") = employee
.Range("D3") = dZone
.Range("E3") = injDate
.Range("F3") = injDesc
.Range("G3") = injWhere
.Range("H3").Formula = _
"='J:\WCM\1.Safety\Forms\ESEWOs\[SEWO " & sewoNum & ".xlsm]SEWO'!$U$16"
.Range("I3").Formula = _
"='J:\WCM\1.Safety\Forms\ESEWOs\[SEWO " & sewoNum & ".xlsm]SEWO'!$T$4"
End With
End If
If Workbooks("SEWO " & sewoNum & ".xlsm").Sheets("SEWO").FirstAidOpB Then
Workbooks.Open safetyData, 3
With Workbooks("WCM Safety Data.xlsm").Sheets("First Aids")
.Activate
.Rows("3:3").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
.Range("A3").Formula = "=ROW()-1"
.Range("B3") = employee
.Range("C3") = injDate
.Range("D3") = injDesc
.Range("E3") = injWhere
.Range("F3") = tAction
End With
End If
End If
MsgBox ("Your SEWO has been submitted" & Chr(13) & "Press SAVE ALL")
Application.Quit
End If
errhand:
If Err.Number = 53 Then
Resume Next
End If
End Sub
Good luck lol
