Dim pVal
Dim swapVal As Boolean
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("G12:T174")) Is Nothing Then '<--- Change Target Range Here
If swapVal = False Then
'---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
Else
swapVal = False
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
Sub ActionSwap()
Dim sCmt As String
Dim i As Long
Dim rCell As Range
Dim area1 As Variant, area2 As Variant, swapVal As Variant
sCmt = InputBox( _
Prompt:="Enter details of the swap. Including when it was actioned and by who." & vbCrLf & _
"Comment will be added to all cells in Selection", _
Title:="DAO Swap Details")
If sCmt = "" Then
MsgBox "No comment added"
Else
For Each rCell In Selection
With rCell
If .Comment Is Nothing Then
.AddComment.Text sCmt
Else
.Comment.Text sCmt & vbLf & .Comment.Text
End If
End With
Next
End If
Set rCell = Nothing
If Selection.Areas.Count <> 2 Then Exit Sub
If Selection.Areas(1).Columns.Count <> Selection.Areas(2).Columns.Count Then
MsgBox ("Selection areas must have the same number of columns")
Exit Sub
End If
area1 = Selection.Areas(1)
area2 = Selection.Areas(2)
If Selection.Areas(1).Columns.Count = 1 Then
swapVal = area1
area1 = area2
area2 = swapVal
Else
For i = LBound(area1, 2) To UBound(area1, 2)
swapVal = area1(1, i)
area1(1, i) = area2(1, i)
area2(1, i) = swapVal
Next
End If
Selection.Areas(1) = area1
Selection.Areas(2) = area2
swapVal = True
End Sub
