Dim pVal
Public Sub Worksheet_SelectionChange(ByVal Target As Range)
pVal = Target.Value
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Resp As String
Dim prevValue
prevValue = pVal
On Error GoTo ExitNow
Application.EnableEvents = False
If Target.CountLarge = 1 And Not Intersect(Target, Range("G9:T172")) Is Nothing Then '<--- Change Target Range Here
'---EDO/EDO-U
If prevValue = "EDO" Or prevValue = "EDO-U" Then
If InStr(Target.Value, "0") Then
With Target
.Interior.Color = RGB(0, 176, 240)
.Font.Color = RGB(255, 0, 0)
'Input Box below. change text and title as needed:
Resp = Application.InputBox("Test Text", _
Title:="Test Text")
End With
End If
Else
'-------OFF/OFF-U
If prevValue = "OFF" Or prevValue = "OFF-U" Then
If InStr(Target.Value, "0") Then
With Target
.Interior.Color = RGB(255, 255, 0)
.Font.Color = RGB(255, 0, 0)
'Input Box below. change text and title as needed:
Resp = Application.InputBox("Test Text", _
Title:="Test text")
End With
End If
End If
End If
'---Absenteeism Details
With Target
Select Case .Value
Case "SDO", "STFN", "CDO", "CTFN" '<- Add more trigger values here if required
Resp = Application.InputBox("Please insert details of absenteeism", _
Title:="Absenteeism Details")
Case "B/OFF", "B/EDO" '<- Add more trigger values here if required
Resp = Application.InputBox("Please insert details of DAO request to be marked unavailable on OFF/EDO.", _
Title:="OFF/EDO Unavailability Details")
End Select
End With
'---DAO Shift Extension Confirmation/Decline
With Target
If InStr(1, .Value, "?") > 0 Or InStr(1, .Value, "OK") > 0 Then
Resp = Application.InputBox("Please enter details of when this shift extension was confirmed by the DAO. " & _
"Including time and date and how it was confirmed", "DAO Shift Extension Confirmation", , , , , , 2)
Else
If InStr(1, .Value, "DEC") > 0 Then
Resp = Application.InputBox("Please enter details of when this shift extension was declined by the DAO. " & _
"Including time and date when it was declined", "DAO Shift Extension Declined", , , , , , 2)
End If
End If
End With
Call AddComment(Target, Resp)
End If
ExitNow:
Application.EnableEvents = True
End Sub
Sub AddComment(rng As Range, cTxt As String)
With rng
If Len(cTxt) > 0 And cTxt <> "False" Then
If .Comment Is Nothing Then
'ActiveSheet.Unprotect
.AddComment Text:=cTxt
'ActiveSheet.Protect DrawingObjects:=False
Else
'ActiveSheet.Unprotect
.Comment.Text .Comment.Text & vbLf & cTxt
'ActiveSheet.Protect DrawingObjects:=False
End If
End If
End With
End Sub
