G'day all,
I have a macro that works perfectly fine, which is below. The problem I have is that I also have a worksheet change sheet code(further below) that I would like not to be triggered when the macro is run.
So when the ActionSwap macro is run, I would like the code in bold not to be executed.
Is there any way that this can happen? I wrote none of this code, it came from a collection of you fine folk, which I appreciate greatly, so I haven't a great deal of knowledge. From the research I have done some sort of EnableEvents line of code?
Appreciate any help or ideas you may have.
Thanks
Hayden
I have a macro that works perfectly fine, which is below. The problem I have is that I also have a worksheet change sheet code(further below) that I would like not to be triggered when the macro is run.
So when the ActionSwap macro is run, I would like the code in bold not to be executed.
Is there any way that this can happen? I wrote none of this code, it came from a collection of you fine folk, which I appreciate greatly, so I haven't a great deal of knowledge. From the research I have done some sort of EnableEvents line of code?
Appreciate any help or ideas you may have.
Thanks
Hayden
VBA Code:
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
End Sub
VBA Code:
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
[B]'---EDO/EDO-U
If prevValue = "EDO" Or prevValue = "EDO-U" Then
If InStr(Target.Value, "0") Then
With Target
ActiveSheet.Unprotect
.Interior.Color = RGB(0, 176, 240)
.Font.Color = RGB(255, 0, 0)
'Input Box below. change text and title as needed:
Resp = Application.InputBox("You are allocating an open shift to a DAO who is on an EDO. Please add the details of when this shift was added to their roster and notify them at the earliest opportunity.", _
Title:="Shift allocaton on ")
End With
End If
Else
'-------OFF/OFF-U
If prevValue = "OFF" Or prevValue = "OFF-U" Then
If InStr(Target.Value, "0") Then
With Target
ActiveSheet.Unprotect
.Interior.Color = RGB(255, 255, 0)
.Font.Color = RGB(255, 0, 0)
'Input Box below. change text and title as needed:
Resp = Application.InputBox("You are allocating an open shift to a DAO who is on an OFF roster. Please follow up with the DAO to confirm at the earliest opportunity.", _
Title:="Shift allocaton on ")
ActiveSheet.Protect DrawingObjects:=False
End With
End If
End If
End If[/B]
'---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
