Prevent the same value from repeating in certain Rows

[sofas]

Welcome

How can I implement the same command and prevent the same value from repeating in multiple rows?

Example

A5:G5 ; A8:G8 ; A11:G11

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim strTargetColumn As String
   Dim nTargetRow As Integer
   Dim nLastRow As Integer
   Dim strMsg As String

   strTargetColumn = Split(Target.Address(, False), "$")(0)
   nTargetRow = Split(Target.Address(, False), "$")(1)
   nLastRow = ActiveSheet.Range(strTargetColumn & ActiveSheet.Rows.Count).End(xlUp).Row

   For nRow = 5 To nLastRow
       If nRow <> nTargetRow Then
          If ActiveSheet.Range(strTargetColumn & nRow).Value = Target.Value Then
             strMsg = "The value has been entered in the same column!"
             MsgBox strMsg, vbExclamation + vbOKOnly, "Duplicate Values"
             Target.Select
             Exit For
          End If
       End If
   Next
End Sub

 

[dmt32]

Hi,
see if this update to your code does what you want

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng         As Range, Area As Range
    
    Const strMsg    As String = "The value has already been entered in the same row!"
    
    Set rng = Me.Range("A5:G5,A8:G8,A11:G11")
    
    On Error GoTo myerror
    If Not Intersect(Target, rng) Is Nothing Then
        Application.EnableEvents = False
        For Each Area In rng.Areas
            If Application.CountIf(Area, Target.Value) > 1 Then
                MsgBox Target.Value & Chr(10) & strMsg, 48, "Duplicate Entry"
                Application.Undo
                Exit For
            End If
        Next Area
        
    End If
myerror:
    Application.EnableEvents = True
End Sub

Dave

 

[sofas]

Hi,
see if this update to your code does what you want

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng         As Range, Area As Range
   
    Const strMsg    As String = "The value has already been entered in the same row!"
   
    Set rng = Me.Range("A5:G5,A8:G8,A11:G11")
   
    On Error GoTo myerror
    If Not Intersect(Target, rng) Is Nothing Then
        Application.EnableEvents = False
        For Each Area In rng.Areas
            If Application.CountIf(Area, Target.Value) > 1 Then
                MsgBox Target.Value & Chr(10) & strMsg, 48, "Duplicate Entry"
                Application.Undo
                Exit For
            End If
        Next Area
       
    End If
myerror:
    Application.EnableEvents = True
End Sub

Dave

Thank you very much, this is exactly what I needed...
genius.

 

[dmt32]

Thank you very much, this is exactly what I needed...
genius.

most welcome & appreciate your feedback

Dave