Compare Entry to Other Cells

[aboly8000]

OK. Try this. I put all the ranges that may change at the very top as range variables. So those should be the only three things in the code that you may need to change.

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng1 As Range
    Dim rng2 As Range
    Dim isect As Range
    Dim isect2 As Range
    Dim cell As Range
    Dim dd() As Variant
    Dim i As Long
    Dim mtch As Boolean
    Dim msg As String
    Dim myEntries As String
    Dim ddRange As Range
    
'***Set column E validation range
    Set rng1 = Range("E7:E12")
'***Set column A validation range
    Set rng2 = Range("A1:A100")
'***Set drop-down list value range
    Set ddRange = Sheets("Sheet1").Range("A1:A3")
    
    
'   See if any updated cells fall in column E range
    Set isect = Intersect(rng1, Target)
'   See if any updated cells fall in column A range
    Set isect2 = Intersect(rng2, Target)
    
'   Exit if updated cells do not fall in either validation range
    If (isect Is Nothing) And (isect2 Is Nothing) Then Exit Sub
    
    Application.EnableEvents = False


'   First check (column E)
    If Not isect Is Nothing Then
'       Build array of drop-down values
        ReDim dd(ddRange.Cells.Count)
        i = 0
        For Each cell In ddRange
            dd(i) = cell.Value
            i = i + 1
        Next cell
    
'       Loop through all intersecting cells
        For Each cell In isect
'           See if cell entry matches any drop-down values
            mtch = False
            For i = LBound(dd) To UBound(dd)
                If cell.Value = dd(i) Then
                    mtch = True
                    Exit For
                End If
            Next i
'           If value is not in list, erase and return message
            If mtch = False Then
                cell.ClearContents
                msg = msg & cell.Address(0, 0) & ","
            End If
        Next cell


'       Build string of validation entries
        For i = LBound(dd) To UBound(dd)
            myEntries = myEntries & dd(i) & ","
        Next i
        myEntries = Left(myEntries, Len(myEntries) - 1)
    
'       Reset validation
        With rng1.Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                xlBetween, Formula1:=myEntries
        End With
    
'       Return message, if necessary
        If Len(msg) > 0 Then
            MsgBox "Invalid entries in cells: " & vbCrLf & Left(msg, Len(msg) - 1), vbOKOnly, "ERROR!"
        End If
    End If
    

'   Second check (column A)
    If Not isect2 Is Nothing Then
'       Loop through all intersecting cells
        For Each cell In isect2
            If (Len(cell) > 0) And (Len(cell) <> 11) Then
                cell.ClearContents
                msg = msg & cell.Address(0, 0) & ","
            End If
        Next cell
            
'       Reset validation
        With rng2.Validation
            .Delete
            .Add Type:=xlValidateTextLength, AlertStyle:=xlValidAlertStop, _
                Operator:=xlEqual, Formula1:="11"
        End With
    
'       Return message, if necessary
        If Len(msg) > 0 Then
            MsgBox "Invalid entries in cells: " & vbCrLf & Left(msg, Len(msg) - 1), vbOKOnly, "ERROR!"
        End If
    End If
    
    Application.EnableEvents = True

End Sub

hi
I want to display an error message for range ("E7: E12"), whenever the value is one with columns ("F7: F12") or ("G7: G12") or ("H7: H12") or ("I7: I12").
For example, when E7 is equal to F7 or G7 or H7 or I7, display an error message.
please help

 

[Joe4]

Split from: https://www.mrexcel.com/forum/excel...-prevent-copy-paste-data-validation-cell.html

As I suggested you do, I moved your latest question to its own thread, especially since it is different than the original question that was asked. The general rule of thumb is if you have a question about the original question asked, you can post back to the original thread someone else started. But if you have your own question, you should start your own thread (and you can provide links to other threads, if you think it may be helpful).

Regarding your question, are you only comparing like rows?
That is, are you only comparing E7 to F7, G7, H7, and I7, or are you comparing F7 to all of F7:F12, G7:G12, H7:H12, and I7:I12?

 

[aboly8000]

only comparing E7 to F7, G7, H7, and I7

 

[Joe4]

Try this:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng As Range
    Dim cell As Range
    
'   See if any cells updated in range E7:E12
    Set rng = Intersect(Target, Range("E7:E12"))
    If rng Is Nothing Then Exit Sub
    
'   Loop through updated cells in E7:E12
    For Each cell In rng
'       See if value matches any value in next 4 columns
        If (cell = cell.Offset(0, 1)) Or (cell = cell.Offset(0, 2)) Or _
            (cell = cell.Offset(0, 3)) Or (cell = cell.Offset(0, 4)) Then
'           If it matches, clear the value
            Application.EnableEvents = False
            cell.ClearContents
            Application.EnableEvents = True
            MsgBox "Value in cell " & cell.Address(0, 0) & _
                " cannot match any value in same row in columns F-I", vbOKOnly, "ENTRY ERROR!"
        End If
    Next cell

End Sub

 

[aboly8000]

Try this:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng As Range
    Dim cell As Range
    
'   See if any cells updated in range E7:E12
    Set rng = Intersect(Target, Range("E7:E12"))
    If rng Is Nothing Then Exit Sub
    
'   Loop through updated cells in E7:E12
    For Each cell In rng
'       See if value matches any value in next 4 columns
        If (cell = cell.Offset(0, 1)) Or (cell = cell.Offset(0, 2)) Or _
            (cell = cell.Offset(0, 3)) Or (cell = cell.Offset(0, 4)) Then
'           If it matches, clear the value
            Application.EnableEvents = False
            cell.ClearContents
            Application.EnableEvents = True
            MsgBox "Value in cell " & cell.Address(0, 0) & _
                " cannot match any value in same row in columns F-I", vbOKOnly, "ENTRY ERROR!"
        End If
    Next cell

End Sub

Thank you very much

 

[Joe4]

You are welcome.

 

[aboly8000]

hi


I need another code:
ıf cell deleted then cell.offset(0 , next in range) be delete

 

[Joe4]

I need another code:
ıf cell deleted then cell.offset(0 , next in range) be delete

Unless your question is directly related to (and dependent upon) the previous question, new questions should be posted in new threads.

 

[aboly8000]

Try this:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng As Range
    Dim cell As Range
    
'   See if any cells updated in range E7:E12
    Set rng = Intersect(Target, Range("E7:E12"))
    If rng Is Nothing Then Exit Sub
    
'   Loop through updated cells in E7:E12
    For Each cell In rng
'       See if value matches any value in next 4 columns
        If (cell = cell.Offset(0, 1)) Or (cell = cell.Offset(0, 2)) Or _
            (cell = cell.Offset(0, 3)) Or (cell = cell.Offset(0, 4)) Then
'           If it matches, clear the value
            Application.EnableEvents = False
            cell.ClearContents
            Application.EnableEvents = True
            MsgBox "Value in cell " & cell.Address(0, 0) & _
                " cannot match any value in same row in columns F-I", vbOKOnly, "ENTRY ERROR!"
        End If
    Next cell

End Sub

I want change this code to:
ıf cell deleted then cell.offset(0 , next all in range) be delete

 

[Joe4]

I want change this code to:
ıf cell deleted then cell.offset(0 , next all in range) be delete

Does it need to be added to the original code there, so the code does BOTH things?

Do you really mean "clear contents" and not "delete". To deleting cells, rows, columns usually involves in shifting all the other cells, rows, columns around.
I am guessing that you mean that if a value in E7:E12 is cleared, you want to clear other cells.
So, are you saying if the value in E7 is cleared, that all values in F7, G7, H7, and I7 shouild also be cleared?