PeterS
PeterS

Reputation: 724

Display Warning Message when a protected cell has been clicked

Currently I have this code. In Column A, I have a current a "YES" or "No" Selection.

Private Sub worksheet_change(ByVal Target As Range)

        If Not Intersect(Target, Range("A:A")) Is Nothing Then

            ActiveSheet.Unprotect
            If Target = "YES" Then

                'Column B to S
                For i = 1 To 18
                    With Target.Offset(0, i)
                        .Locked = False
                        .FormatConditions.Add Type:=xlExpression, Formula1:="=ISBLANK(" & Target.Offset(0, i).Address & ")"
                        With .FormatConditions(.FormatConditions.Count)
                            .SetFirstPriority
                            .Interior.ColorIndex = 4
                        End With
                    End With
                Next i

ElseIf Target = "NO" Then

            For i = 1 To 73
                With Target.Offset(0, i)
                    .Value = ""
                    .Locked = True
                    .FormatConditions.Delete

                End With
            Next i
            End If
            ActiveSheet.Protect

        End If

    End Sub

Now when the user click the cell in Column T (19), I want to display a warning message to the user that this is not applicable for "Yes" selection.

Upvotes: 1

Views: 984

Answers (1)

user4039065
user4039065

Reputation:

This seems like it should do the task you are asking.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A:A")) Is Nothing Then
        On Error GoTo bm_SafeExit
        Application.EnableEvents = False
        Me.Unprotect
        Dim trgt As Range
        For Each trgt In Intersect(Target, Range("A:A"))
            If LCase(trgt.Value2) = "yes" Then
                With trgt.Offset(0, 1).Resize(1, 18)
                    .Locked = False
                    With .FormatConditions.Add(Type:=xlExpression, Formula1:="=ISBLANK(B" & trgt.Row & ")")
                        .Interior.ColorIndex = 4
                    End With
                End With
            Else
                With trgt.Offset(0, 1).Resize(1, 73)
                    .Value = vbNullString
                    .Locked = True
                    .FormatConditions.Delete
                End With
            End If
        Next trgt
    End If

bm_SafeExit:
    Application.EnableEvents = True
    Me.Protect Userinterfaceonly:=True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("T:XFD")) Is Nothing Then
        On Error GoTo bm_SafeExit
        Application.EnableEvents = False
        Dim trgt As Range
        For Each trgt In Intersect(Target, Range("T:XFD"))
            If LCase(Me.Cells(trgt.Row, "A").Value2) = "yes" Then
                MsgBox "Don't try to put Yes here", vbCritical + vbOKOnly, "Bad Choice"
                Me.Cells(trgt.Row, "A").Select
            End If
        Next trgt
    End If

bm_SafeExit:
    Application.EnableEvents = True

End Sub

Set watches and breakpoints and use [F8] and [Ctrl]+[F8} to walk through the code.

Upvotes: 1

Related Questions