Another Conditional Error Message

[bhath2]

The macro below creates an error message when an entry is in both columns (P & Q) of a given row. I would like to do the same thing as this, but, instead, if there is an entry in column Q, there MUST be an entry in column R (and vice versa). Just like this existing macro, I would like for it to automatically select the offending cell, but I dont want it to delete the contents of the cell (because its already empty, of course). I suspect that all of this can be accomplished with slight changes to the existing macro, but I'm not sure how to do it. Any help is appreciated.

_____________________________________________________________

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myRng As Range, myMsg As String

'if more than 1 cell is changed, exit macro
If Target.Count > 1 Then Exit Sub

'if the changed cell was not in P2:Q1000, exit macro
If Intersect(Target, [P2:Q1000]) Is Nothing Then Exit Sub

'if the new value of the changed cell is blank, exit macro
If Target.Value = "" Then Exit Sub

'otherwise

Application.EnableEvents = False

'detect the column of the changed cell
Select Case Target.Column
Case Is = 16 'column P
Set myRng = Target.Offset(, 1) 'sets cell in column Q as range
myMsg = "Complaint Issue."
Case Is = 17 'column Q
Set myRng = Target.Offset(, -1) 'sets cell in column P as range
myMsg = "NCMR Issue."
End Select

'if the value of the cell opposite the changed cell is not blank
If myRng <> "" Then
With Target
.ClearContents 'delete value entered into changed cell
.Select 'select the changed cell
End With
'display message
MsgBox "There is already an entry in " & myMsg & " An entry can be made as an NCMR or Complaint but not both.", vbOKOnly + vbCritical, "Duplicate Entry"
End If

Application.EnableEvents = True

End Sub

 

[Barrie Davidson]

Something like?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myRng As Range, myMsg As String

'if more than 1 cell is changed, exit macro
If Target.Count > 1 Then Exit Sub

'if the changed cell was not in columns Q:R, exit macro
If Intersect(Target, Columns("Q:R")) Is Nothing Then Exit Sub

'if the new value of the changed cell is blank, exit macro
If Target.Value = "" Then Exit Sub

'otherwise

Application.EnableEvents = False

'detect the column of the changed cell
Select Case Target.Column
    Case Is = 17 'column Q
    Set myRng = Target.Offset(, 1) 'sets cell in column R as range
    myMsg = "Complaint Issue."
Case Is = 18 'column R
    Set myRng = Target.Offset(, -1) 'sets cell in column Q as range
    myMsg = "NCMR Issue."
End Select

'if the value of the cell opposite the changed cell is not blank
If myRng = "" Then
    Target.Select 'select the changed cell
    'display message
    MsgBox "There is no entry in " & myMsg & _
        " An entry must be made in both.", _
        vbOKOnly + vbCritical, "Duplicate Entry"
End If

Application.EnableEvents = True

End Sub

 

[bhath2]

Barrie,
The code you gave above works great if Q contains a value and R is blank, but it doesn't do anything if R contains a value and Q is blank. Any ideas why?

I've also tried duplicating it for other columns in my sheet (S and T) and it didnt work there either. I don't know if it makes a difference but I've put the two sets of code (from the previous responses above) together in the Worksheet's code, so it looks like this:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myRng As Range, myMsg As String

'NCMR_vs_Complaint_Error_Message_Macro
'if more than 1 cell is changed, exit macro
If Target.Count > 1 Then Exit Sub

'if the changed cell was not in P2:Q1000, exit macro
If Intersect(Target, [P2:Q1000]) Is Nothing Then Exit Sub

'if the new value of the changed cell is blank, exit macro
If Target.Value = "" Then Exit Sub

'otherwise

Application.EnableEvents = False

'detect the column of the changed cell
Select Case Target.Column
Case Is = 16 'column P
Set myRng = Target.Offset(, 1) 'sets cell in column Q as range
myMsg = "Complaint Issue."
Case Is = 17 'column Q
Set myRng = Target.Offset(, -1) 'sets cell in column P as range
myMsg = "NCMR Issue."
End Select

'if the value of the cell opposite the changed cell is not blank
If myRng <> "" Then
With Target
.ClearContents 'delete value entered into changed cell
.Select 'select the changed cell
End With
'display message
MsgBox "There is already an entry in " & myMsg & " An entry can be made as an NCMR or Complaint but not both.", vbOKOnly + vbCritical, "Duplicate Entry"
End If

Application.EnableEvents = True


'Complaint_must_include_Customer_Macro
'if more than 1 cell is changed, exit macro
If Target.Count > 1 Then Exit Sub

'if the changed cell was not in columns Q:R, exit macro
If Intersect(Target, [Q2:R1000]) Is Nothing Then Exit Sub

'if the new value of the changed cell is blank, exit macro
If Target.Value = "" Then Exit Sub

'otherwise

Application.EnableEvents = False

'detect the column of the changed cell
Select Case Target.Column
Case Is = 17 'column Q
Set myRng = Target.Offset(, 1) 'sets cell in column R as range
myMsg = "the 'Customer' column."
Case Is = 18 'column R
Set myRng = Target.Offset(, -1) 'sets cell in column Q as range
myMsg = "Complaint Issue."
End Select

'if the value of the cell opposite the changed cell is not blank
If myRng = "" Then
Target.Select 'select the changed cell
'display message
MsgBox "There is no entry in " & myMsg & _
" Please be sure to indicate the customer for this complaint.", _
vbOKOnly + vbCritical, "Duplicate Entry"
End If

Application.EnableEvents = True

End Sub
____________________end code

Again, the first part "NCMR_vs_Complaint_Error_Message_Macro" works fine, but only half of "Complaint_must_include_Customer_Macro" works. Please help. Thanks.