Followup to "search range for duplicates"

D

Doug Loewen

I guess I didn't give enough info... I have a Named Range
for MondayNames, another for TuesdayNames, etc. All 5
Ranges are in Column A. Greg gave me this code which
works to find a duplicate, but it doesn't let me duplicate
names in Tuesday that I used in Monday. How can I
separate the search to work each range by itself?

The second problem I have is I don't know how to handle
the '..Select or ..Interior' I get a compile error.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range
With Target
Set Rng = Columns(.Column)
If Application.CountIf(Rng, .Value) > 1 Then
..Select
..Interior.ColorIndex = 6
MsgBox "Name already exists"
..Interior.ColorIndex = xlNone
End If
End With
End Sub
Click to expand...

Thanks again for the help!!
 
G

Greg Wilson

The double leading periods is website based corruption.
These should only be a single leading period
(eg. ".Select"). This post will likely be similarly
affected. The code I gave you will work only if the ranges
are in separate columns which was my read of your original
post.

The following code assumes that you have 5 named
ranges: "MonNames", "TuesNames" etc. The code will treat
each named range separately. The temporary yellow
highlight was thrown in as a suggestion only.

Written on the "super-fast" with minimal testing. Hope it
fits the bill this time.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim RngArr As Variant, i As Integer
RngArr = Array(Range("MonNames"), Range("TuesNames"), _
Range("WedNames"), Range("ThursNames"), Range("FriNames"))
If Target.Count > 1 Then Exit Sub
For i = 1 To 5
If Not Intersect(Target, RngArr(i - 1)) Is Nothing Then
With Target
If Application.CountIf(RngArr(i - 1), .Value) > 1 Then
..Select
..Interior.ColorIndex = 6
MsgBox "Name already exists !!!"
..Interior.ColorIndex = xlNone
End If
End With
End If
Next
End Sub

Regards,
Greg
 
B

BrianB

You will see that your added requirement increases the code require
quite a bit :-

'--------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim r As String
Dim Rng As Range
'----------------------
If Target.Column = 1 Then
'- find target range
For Each nm In ActiveWorkbook.Names
r = (Right(nm.RefersTo, Len(nm.RefersTo) - 1))
r = Mid(r, InStr(1, r, "!") + 1, 255)
Set Rng = ActiveSheet.Range(r)
If Not Intersect(Target, Rng) Is Nothing Then
Exit For
End If
Next
'- check for duplicate
If Application.WorksheetFunction. _
CountIf(Rng, Target.Value) > 1 Then
Target.Interior.ColorIndex = 6
MsgBox ("Name already exists.")
Target.Interior.ColorIndex = xlNone
Target.Value = ""
End If
End If
End Sub
'------------------------------------------------------------
 
Top