Unique Values

Hey guys and gals,

I need an error box to come up when a value is the same as a value that is already entered.

Column D has Names lets say Bill, Bob, Jack
Column J has Names lets say Jerry, Shelly, Joe

Now if I enter Bill into either column again I want an error box come up and tell let me know that value already exists and I want it to simply clear that cell.

I have adapted this code, but it only works with one column how do I make it work with the other column.

I don't want it to check the columns in between.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

    Dim LLoop As Integer
    Dim LTestLoop As Integer
    
    Dim Lrows As Integer
    Dim LRange As String
    Dim LChangedValue As String
    Dim LTestValue As String
    
    'Test first 200 rows in spreadsheet for uniqueness
    Lrows = 200
    LLoop = 2
    
    'Check first 200 rows in spreadsheet
    While LLoop <= Lrows
        LChangedValue = "D" & CStr(LLoop)
        
        If Not Intersect(Range(LChangedValue), Target) Is Nothing Then
            If Len(Range(LChangedValue).Value) > 0 Then
            
                'Test each value for uniqueness
                LTestLoop = 2
                While LTestLoop <= Lrows
                    If LLoop <> LTestLoop Then
                        LTestValue = "D" & CStr(LTestLoop)
                        'Value has been duplicated in another cell
                        If Range(LChangedValue).Value = Range(LTestValue).Value Then
                            'Clear Contents
                            Range(LChangedValue).ClearContents
                            MsgBox Range(LChangedValue).Value & " already exists in cell D" & LTestLoop
                            Exit Sub
                        Else
                            Range(LChangedValue).Interior.ColorIndex = xlNone
                        End If
                            
                    End If
                    
                    LTestLoop = LTestLoop + 1
                Wend
                
            End If
        End If
        
        LLoop = LLoop + 1
    Wend
    
End Sub

Thanks
Steven

Hi,

Can you not do what is required with standard validation, using the Custom option and the formula

=COUNTIF($A:$B,A1)<=1

?

This should work...

Private Sub Worksheet_Change(ByVal Target As Range)
For Each c In Range("A1:B5")
    If Target.Value <> "" And Target.Value = c.Value Then
        MsgBox "Value already entered elsewhere!"
        Target.ClearContents
    End If
Next c
End Sub

I didn't look at your code but I think you should be able to incorporate it

Well I thought that was going to work,

It looked like it would work.

But everytime I entered data into any cell within those ranges I would get the error all the time.

You see only those two columns D and G have to be unique
all other columns can have duplicates.

Originally Posted by incjourn

This should work...

Private Sub Worksheet_Change(ByVal Target As Range)
For Each c In Range("A1:B5")
    If Target.Value <> "" And Target.Value = c.Value Then
        MsgBox "Value already entered elsewhere!"
        Target.ClearContents
    End If
Next c
End Sub

I didn't look at your code but I think you should be able to incorporate it

Change the validation type to custom and use

=AND(ISNUMBER(MATCH(Me, CrewName, 0)), COUNTIF(D1:D10, Me) + COUNTIF(J1:J10, Me) = 1)

... Where Me is the address of the active cell when you enter the formula.