Solved

test if values are unique vba

Posted on 2010-08-13
9
325 Views
Last Modified: 2012-05-10
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
0
Comment
Question by:thmh
  • 4
  • 2
  • 2
  • +1
9 Comments
 
LVL 92

Accepted Solution

by:
Patrick Matthews earned 100 total points
ID: 33431903
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

Open in new window

0
 
LVL 45

Expert Comment

by:patrickab
ID: 33432029
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
        coll.Add CStr(celle), CStr(celle)
        If Err <> 0 Then
            MsgBox "One or more are the same"
            Exit Sub
        End If
    Next celle
End If

End Sub

Open in new window

thmh-04.xls
0
 

Author Comment

by:thmh
ID: 33432054
what if cells are in different locations

 
       A      BD      CP      DJ
1     4                        
2               9
3                         3
5                                    7
0
 
LVL 45

Expert Comment

by:patrickab
ID: 33432070
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
Highfive Gives IT Their Time Back

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
LVL 80

Expert Comment

by:byundt
ID: 33432078
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

Open in new window

0
 
LVL 80

Assisted Solution

by:byundt
byundt earned 40 total points
ID: 33432115
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
 
LVL 45

Assisted Solution

by:patrickab
patrickab earned 40 total points
ID: 33432171
>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
        coll.Add CStr(celle), CStr(celle)
        If Err <> 0 Then
            MsgBox "One or more are the same"
            Exit Sub
        End If
    Next celle
End If

End Sub

Open in new window

0
 

Author Comment

by:thmh
ID: 33432345
tnx all
matthewspatrick solutions is best for what i need
0
 
LVL 45

Expert Comment

by:patrickab
ID: 33432573
thmh - Tks4pts - Patrick(ab)
0

Featured Post

What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

Join & Write a Comment

Lync meeting or Lync conferencing is what many organizations would like to deploy to allow them save money. But companies are now giving up for various reasons, one of which is that they cannot join external meetings (non-federated company meetings)…
Many companies are making the switch from Microsoft to Google Apps (https://www.google.com/work/apps/business/). Use this article to learn more about what Google Apps has to offer and to help if you’re planning on migrating to Google Apps. It is …
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

757 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

19 Experts available now in Live!

Get 1:1 Help Now