Check duplicates

[roninn75]

good day

i want to check for duplicates with vba. i know one can do so with conditional formatting but in this instance vba will work better.
i added the following code to the worksheet change event

Code: Select all

Dim d As Object, e
Set d = CreateObject("scripting.dictionary")
For Each e In Intersect(Columns(ActiveCell.Column), ActiveSheet.UsedRange)
If e.Value <> vbNullString Then
    If Not d.exists(e.Value) Then d(e.Value) = 1 Else _
        e.Font.ColorIndex = 4
End If
Next

this however only checks one column, i want o be able to check across columns.
how can i specify the exact columns i want to check? in my workbook the data lies in columns D5:D24, J5:J24, P5:P24, AB5:AB24 and AH5:AH24. the values which i want highlighted are below that.

your assistance is highly appreciated.

[HansV]

What do you mean by "the values which i want highlighted are below that"?

[roninn75]

the data is reflected in the columns as specified. however, the duplicates will reside from rows 26 onwards. so if i have the following data in:
D5 = john
J10 = peter
P15 = susan

in columns D26: AH55 the following data is listed
D26 = amy
D27 = mike
D28 = john
J26 = joey
AB26 = susan
AH26 = peter

in this example, the values in D26:AH55, the following will be highlighted:
peter
john
susan

i hope this makes sense.

[Rudi]

This is untested aircode...

Try

Code: Select all

Dim col As Range
Dim d As Object, e
    Set d = CreateObject("scripting.dictionary")
    For Each col In ActiveSheet.UsedRange.Columns
        For Each e In col.cells
            If e.Value <> vbNullString Then
                If Not d.Exists(e.Value) Then d(e.Value) = 1 Else _
                   e.Font.ColorIndex = 4
            End If
        Next e
    Next col

[HansV]

So if I understand you correctly, you are NOT looking for duplicates within a range, but for overlap between two separate ranges. Or am I wrong?

[roninn75]

if i have listed names from row 26 onwards, when i input the a name in the ranges as listed D5:D24 up to AH24, the names at the bottom(from row 26) is highlighted. this will indicate i cannot use that name again if i used it once.

[roninn75]

Rudi, your solution gives an error on line

Code: Select all

If e.Value <> vbNullString Then

whenever a name is inputted.

[HansV]

Does this do what you want?

Code: Select all

Sub HighlightDups()
    Dim d As Object, e As Range
    Set d = CreateObject("scripting.dictionary")
    ' Step 1: create a dictionary entry for each name in rows 5 to 24
    For Each e In Range("D5:D24,J5:J24,P5:P24,AB5:AB24,AH5:AH24")
        If e.Value <> "" Then
            d(e.Value) = 1
        End If
    Next e
    ' Step 2: highlight the duplicates in D26:AH55
    For Each e In Range("D26:AH55")
        If e.Value <> "" Then
            If d.exists(e.Value) Then
                e.Font.ColorIndex = 4
            End If
        End If
    Next e
End Sub

[Rudi]

Rudi, your solution gives an error on line

Code: Select all

If e.Value <> vbNullString Then

whenever a name is inputted.

Either copy my code above again (I modified it) or edit the line...

Code: Select all

For Each e In col

to

Code: Select all

For Each e In col.Cells

[roninn75]

thanks guys, this works.