Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Name = Range("B2").Value
If Target.Cells.Count > 1 Or Target.HasFormula Then Exit Sub
On Error Resume Next
If Not Intersect(Target, Range("B2:B200")) Is Nothing Then
Application.EnableEvents = False
Target = UCase(Target)
Application.EnableEvents = True
End If
On Error GoTo 0
If Target.Count = 1 Then
If Not Intersect(Target, Range("D4:AH200")) Is Nothing Then
Select Case Target
Case TimeSerial(0, 30, 0), TimeSerial(1, 0, 0), TimeSerial(1, 30, 0), TimeSerial(2, 0, 0), TimeSerial(2, 30, 0), TimeSerial(3, 0, 0), TimeSerial(3, 30, 0), TimeSerial(4, 0, 0), TimeSerial(4, 30, 0), TimeSerial(5, 0, 0), TimeSerial(5, 30, 0), TimeSerial(6, 0, 0), TimeSerial(6, 30, 0), TimeSerial(7, 0, 0)
icolor = 37
Target.NumberFormat = "[h]:mm"
Target.Font.Bold = True
Target.Font.ColorIndex = 56
Target.Borders.LineStyle = xlContinuous
Target.Borders.ColorIndex = 48
Target.Borders.Weight = xlThin
Case "H", "Hha", "Hhp"
icolor = 43
Target.HorizontalAlignment = xlCenter
Target.Font.Bold = True
Target.Font.ColorIndex = 56
Target.Borders.LineStyle = xlContinuous
Target.Borders.ColorIndex = 48
Target.Borders.Weight = xlThin
Case "ML"
icolor = 38
Target.HorizontalAlignment = xlCenter
Target.Font.Bold = True
Target.Font.ColorIndex = 56
Target.Borders.LineStyle = xlContinuous
Target.Borders.ColorIndex = 48
Target.Borders.Weight = xlThin
Case Else
icolor = xlNone
Target.Borders.ColorIndex = xlNone
End Select
Target.Interior.ColorIndex = icolor
End If
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Range("B:AL").Columns.AutoFit
End Sub
Private Sub Worksheet_Calculate()
Dim rngCell As Range
For Each rngCell In Range(Cells(2, "C"), Cells(Rows.Count, "C").End(xlUp)).Cells
With rngCell
.Offset(, 35).NumberFormat = IIf(UCase(.Value) = "P/T", "[hh]:mm", "General")
End With
Next rngCell
End Sub
HAVE A VERY MERRY XMAS!!!
Bookmarks