Sub EnterHours2()
' EnterHours2 Macro
' Get current state of various Excel settings so when they are changed in this code they can be return to this state at the end of the code
screenUpdateState = Application.ScreenUpdating
statusBarState = Application.DisplayStatusBar
eventsState = Application.EnableEvents
' Message box if there is no name entered
If Range("F3").Value = "" Then
MsgBox "You Must Enter an Employee Name!"
Range("F3").Select
Exit Sub
End If
' Sheet tab names cannot contain the characters /, \, [, ], *, ?, or :
' Verify that none of these characters are present in the employee name cell's entry.
Dim IllegalCharacter(1 To 7) As String, i As Integer
IllegalCharacter(1) = "/"
IllegalCharacter(2) = "\"
IllegalCharacter(3) = "["
IllegalCharacter(4) = "]"
IllegalCharacter(5) = "*"
IllegalCharacter(6) = "?"
IllegalCharacter(7) = ":"
For i = 1 To 7
If InStr(Range("F3").Value, (IllegalCharacter(i))) > 0 Then
MsgBox "You used a character that violates naming rules." & vbCrLf & vbCrLf & _
"Please re-enter an employee name without the ''" & IllegalCharacter(i) & "'' character.", 48, "Not a possible employee name !!"
Application.EnableEvents = False
Application.EnableEvents = True
Exit Sub
End If
Next i
' Verify that the proposed sheet name (employee name) does not already exist in the workbook
Dim strSheetName As String, wks As Worksheet, bln As Boolean
strSheetName = Trim(Range("F3").Value)
On Error Resume Next
Set wks = ActiveWorkbook.Worksheets(strSheetName)
On Error Resume Next
If Not wks Is Nothing Then
bln = True
Else
bln = False
Err.Clear
End If
If bln = False Then
Else
MsgBox "There is already an employee named " & strSheetName & "." & vbCrLf & _
"Please enter a unique employee name."
Application.EnableEvents = False
Application.EnableEvents = True
Exit Sub
End If
' Turn off some Excel functionality so code runs faster
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
' Unprotects workbook if it is protected without a password
ActiveWorkbook.Unprotect
' Unprotects Index sheet
Sheets("Index").Select
ActiveSheet.Unprotect
' Copies worksheet
Sheets("Calculator").Select
Sheets("Calculator").Copy After:=Sheets(2)
' Unprotects worksheet if it is protected without a password
ActiveSheet.Unprotect
' Remove sheet tab color
ActiveSheet.Tab.ColorIndex = xlColorIndexNone
' Makes the class code hours and piece rate figures bold
Range("G10:G17,J18:J20").Select
Selection.Font.Bold = True
' Makes the class code hours and piece rate figures red if greater than zero
Dim myRange As Range
Dim cell As Range
Set myRange = Range("G10:G17,J18:J20")
For Each cell In myRange
If cell.Value > 0 And cell.Value <> "Unknown" Then cell.Font.ColorIndex = 3
Next
' Clears instruction cell and all comments from copy
Range("B22").Select
Selection.ClearContents
Cells.ClearComments
' Change name of title
Range("B1").Select
ActiveCell.FormulaR1C1 = "Hours Recorded " & Format(Now, "mm/dd/yyyy")
' Deletes shapes on copy (buttons)
Dim Shp As Shape
For Each Shp In ActiveSheet.Shapes
Shp.Delete
Next Shp
' Names the copy of the worksheet to the employee name
Worksheets("Calculator (2)").Name = Range("F3").Value
' Copy Index linked button from Calculator sheet
Sheets("Calculator").Shapes("Rounded Rectangle 3").Copy
Range("L3").Select
ActiveSheet.Paste
' Copy Calculator linked button from Index sheet
Sheets("Index").Shapes("Rounded Rectangle 1").Copy
Range("J3").Select
ActiveSheet.Paste
' Insert Data into index sheet
Dim lRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Index")
lRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
With ws
.Cells(lRow, 1).Value = ActiveSheet.Range("F3").Value
End With
' Protects copy sheet
ActiveSheet.Protect
Range("M20").Select
' Select Index sheet
Sheets("Index").Select
' Hyper link name on to the worksheet that corresponds to it
Range("A1").Select
lastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Cells(lastRow, 1).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
"'" & Sheets("Calculator").Range("F3").Value & "'!A1", TextToDisplay:=Sheets("Calculator").Range("F3").Value
' Add background color and border to cell
Range("A1").Select
lastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Cells(lastRow, 1).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlHairline
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("A1").Select
' Sort list on Index sheet
Range("A2:A1000").Select
ActiveWorkbook.Worksheets("Index").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Index").Sort.SortFields.Add Key:=Range("A2"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Index").Sort
.SetRange Range("A2:A1000")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A1").Select
' Protects Index sheet
ActiveSheet.Protect
' Returns to main sheet and clears contents
Sheets("Calculator").Select
Range("D7:D20,G10:G15,F3,F7,N6:N19,J12:J17,L8").Select
Selection.ClearContents
Range("F3").Select
' Restore states, this returns excel functionality that was previously turned off to the state recorded at the beginning of the code
Application.ScreenUpdating = screenUpdateState
Application.DisplayStatusBar = statusBarState
Application.EnableEvents = eventsState
' Protects main sheet
ActiveSheet.Protect
ActiveSheet.EnableSelection = xlUnlockedCells
' Protects workbook
ActiveWorkbook.Protect
End Sub
