# test if values are unique vba

hy ,
how to test if values in 4 cells are unique

A      B      C      D
1     4      9       7      5

something like :
if A1 <>B1<>C1<>D1 then
###### Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Commented:
I would loop through and use CountIf:
``````Dim rng As Range, cel As Range
Dim Counter As Long

Set rng = ActiveSheet.Range("a1:d1")
For Each cel In rng.Cells
Counter = Counter + Application.CountIf(rng, cel.Value)
Next
If Counter > 4 Then
'duplicates
Else
'no duplicates
End If
``````
0

Experts Exchange Solution brought to you by

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Commented:
thmh,

The code below is in the attached file. Try changing one of the numbers so that it is the same as another.

Hope it helps

Patrick
``````Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Dim celle As Range
Dim coll As New Collection

With Sheets("Sheet1")
Set rng = Range(.Cells(1, "A"), .Cells(1, "D"))
End With
If Not Intersect(rng, Target) Is Nothing Then
For Each celle In rng
On Error Resume Next
If Err <> 0 Then
MsgBox "One or more are the same"
Exit Sub
End If
Next celle
End If

End Sub
``````
thmh-04.xls
0
Author Commented:
what if cells are in different locations

A      BD      CP      DJ
1     4
2               9
3                         3
5                                    7
0
Commented:
If you want just a formula, perhaps this will do it:

=IF(OR(COUNTIF(A1:D1,A1)<>1,COUNTIF(A1:D1,B1)<>1,COUNTIF(A1:D1,C1)<>1,COUNTIF(A1:D1,D1)<>1),"Duplicates present","No duplicates")

Patrick(ab)
0
Mechanical EngineerCommented:
You could use an array-entered formula like:
=SUM(IFERROR(1/COUNTIF(A1:D1,A1:D1),0))=COUNTA(A1:D1)                  returns either TRUE or FALSE; requires Excel 2007 or later
=SUM(IF(ISERROR(1/COUNTIF(A1:D1,A1:D1)),0,1/COUNTIF(A1:D1,A1:D1)))=COUNTA(A1:D1)                  works in any version of Excel

To array-enter a formula:
1) Click in the formula bar
2) Hold the Control and Shift keys down
3) Hit Enter
4) Release all three keys

Excel should respond by adding curly braces { } surrounding the formula. If not, repeat steps 1 through 4.

If you prefer a user-defined function, I posted one in the snippet.
``````Function NoDupes(Values As Variant) As Boolean
Dim v As Variant
Dim coll As New Collection
On Error Resume Next
For Each v In Values
If v <> "" Then coll.Add CStr(v), CStr(v)
Next
NoDupes = Err = 0
On Error GoTo 0
End Function
``````
0
Mechanical EngineerCommented:
The NoDupes user-defined function will work with non-contiguous cells if you use the Union operator (surrounding the list of cells by parentheses). These cells must all be on the same worksheet.
=NoDupes((A1,B2,C3,D4))
0
Commented:
>what if cells are in different locations

A      BD      CP      DJ
1     4
2               9
3                         3
5                                    7

Change the macro to that shown below.

Patrick(ab)
``````Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Dim celle As Range
Dim coll As New Collection

With Sheets("Sheet1")
Set rng = .Range("A1,BD2,CP3,DJ5")
End With
If Not Intersect(rng, Target) Is Nothing Then
For Each celle In rng
On Error Resume Next
If Err <> 0 Then
MsgBox "One or more are the same"
Exit Sub
End If
Next celle
End If

End Sub
``````
0
Author Commented:
tnx all
matthewspatrick solutions is best for what i need
0
Commented:
thmh - Tks4pts - Patrick(ab)
0
###### It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.