Sheet code for conditional formatting

[MeaclH]

G'day all,
Bit of a curly one. I am hoping to have a sheet code that might be able to achieve the following.

Range of cells may include the following values - EDO or EDO-U
If any of those cells are changed from those values to any value containing a 0, I would like the formatting of that cell to be changed. I can't use a simple conditional formatting rule because there are other cells in the range which may already have a value containing 0, and the formatting needs be different.

Any ideas on if and how this might be able to be achieved?

Cheers
Hayden

 

[MeaclH]

I added another global var to set as a flag between the two subs, so that should help:

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
[B]        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[/B]
        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

Hey again mate,
One more thing I promise..... I think.... I hope.
How can i have the highlighted section below be non case sensitive? so if cell is changed to "ok" the code will still execute and also if "dec" is entered it will run too.

'---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

Thanks heaps!
Hayden

 

[dreid1011]

Try adding this argument to each instance of InStr:

InStr(1, .Value, "?", vbTextCompare)

 

[MeaclH]

Try adding this argument to each instance of InStr:

InStr(1, .Value, "?", vbTextCompare)

Legend. Thanks heaps mate