Private Sub Workbook_BeforeClose(Cancel As Boolean)
bIsClosing = True
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If Cancel = True Or bIsClosing = False Then Exit Sub
Run "HideAll"
End Sub
Private Sub Workbook_Deactivate()
If bIsClosing = False Then Exit Sub
Run "HideAll"
End Sub
Private Sub Workbook_Open()
Run "ShowAll"
Dim Sh As Worksheet
For Each Sh In ThisWorkbook.Worksheets
Sh.Protect Password:="Happy Feet", DrawingObjects:=True, Contents:=True, Scenarios:=True
Sh.EnableSelection = xlUnlockedCells
Next Sh
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Msg, Style, Title, Response
Dim r As Range
'//change cells to uppercase.
Dim rng1 As Range, rng2 As Range, cell As Range, rng3 As Range, rng4 As Range
On Error GoTo errTrap
Application.EnableEvents = False
If Not Intersect(Target, Rows(4)) Is Nothing Then
Set rng3 = Intersect(Target, Rows(4))
Set rng4 = Intersect(ActiveSheet.UsedRange, rng3)
For Each cell In rng3
If cell.Formula <> "" Then
cell.Formula = Format(cell.Formula, ">")
End If
Next cell
End If
If Not Intersect(Target, Rows(7)) Is Nothing Then
Set rng1 = Intersect(Target, Rows(7))
Set rng2 = Intersect(ActiveSheet.UsedRange, rng1)
For Each cell In rng1
If cell.Formula <> "" Then
cell.Formula = Format(cell.Formula, ">")
End If
Next cell
End If
If Intersect(Target, Range("C7:Q7")) Is Nothing Then GoTo errTrap
If Not IsEmpty(Cells(10, Target.Column)) Or Target.Cells.Count > 1 Then GoTo errTrap
If Target.Value = "PT" Then
Msg = "If you intend to use this Labor Code, PT for Patch" _
& vbCrLf & "Please enter your AWA Number in row 10 below" _
& vbCrLf & vbCrLf & "And don't forget to include a copy of the AWA with payroll" _
& vbCrLf & " No AWA, No PAY"
Style = vbOKOnly
Title = " REMINDER"
Response = MsgBox(Msg, Style, Title)
If Response = vbOK Then
End If
End If
'If you have any worksheet to exclude
If Sh.Name = "Sheet2" Then Exit Sub
For Each r In Target
If Len(r.Value) <> Len(Trim(r.Value)) Then
MsgBox "You just entered a leading space character in" & vbCrLf & _
" cell " & r.Address(0, 0) & "." & vbCrLf & vbCrLf & _
"If you intend to delete the value in that or any cell, " & vbCrLf & _
"please press the Delete button on your keyboard.", 16, " No leading spaces allowed !!"
Application.EnableEvents = False
r.Value = Trim(r.Value)
Application.EnableEvents = True
End If
Next
errTrap:
Application.EnableEvents = True
End Sub