duplicate data entry

[taniedzw]

Hi,
I have a user form that allows users to enter a 'tag number' in column
A. I would like to prevent the entry of duplicate tag numbers in this
column, perhaps have a warning message pop up or something. How would
I go about doing this so it would work for the entire column. Where
would I enter the formula.

Another thing is sometimes it is required to enter text instead of a
number for the tag number column, in this case I would still like to
allow duplicate entry for text only.

For this reason I'm not sure if the 'Data Validation' tool will work.

Thanks in advance for the help

Tim

 

[Bob Phillips]

Tim,

Try this

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngTest As Range
Dim newVal

Set rngTest = Me.Range("A1:A100")
On Error GoTo ws_exit:
Application.EnableEvents = False
If Not Intersect(Target, rngTest) Is Nothing Then
With Target
If WorksheetFunction.CountIf(rngTest, .Value) > 1 Then
newVal = .Value
.Value = ""
MsgBox "Duplicate - already on row " &
WorksheetFunction.Match(newVal, rngTest, 0)
End If
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub

'This is worksheet event code, which means that it needs to be
'placed in the appropriate worksheet code module, not a standard
'code module. To do this, right-click on the sheet tab, select
'the View Code option from the menu, and paste the code in.


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

 

[Jason Morin]

Select column A and go into Validation. Select Custom and
use:

=OR(ISTEXT($A1),AND(ISNUMBER($A1),COUNTIF($A:$A,$A1)=1))

to prevent duplicate numbers but allow duplicate text
entries.

HTH
Jason
Atlanta, GA

 

[taniedzw]

I'm getting an error when I enter the code you reccommended.

The error comes up as a yellow arrow pointing to a line in the cod
that is highlighted yellow that says

Private Sub Worksheet_Change(ByVal Target As Range)

but it also highlights this line

MsgBox "Duplicate - already on row " &

Any idea why I'm getting that error... Maybe I just am no
personalizing it to my file enough

 

[Jason Morin]

I think you meant to direct your question to Bob. But try
the validation - no code needed.

Jason

 

[Bob Phillips]

Did you follow the instructions on where to place the code?

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

 

[taniedzw]

Yes, I right clicked the tab and then went to view code, then pasted i
in there.
I tried overwriting the exixting code that was there when it starts up
and I also tried inserting it after the existing initial code, neithe
worked

 

[Bob Phillips]

It might just be line-wrap, so try this version

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngTest As Range
Dim newVal

Set rngTest = Me.Range("A1:A100")
On Error GoTo ws_exit:
Application.EnableEvents = False
If Not Intersect(Target, rngTest) Is Nothing Then
With Target
If WorksheetFunction.CountIf(rngTest, .Value) > 1 Then
newVal = .Value
.Value = ""
MsgBox "Duplicate - already on row " & _
WorksheetFunction.Match(newVal, rngTest, 0)
End If
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

 

[taniedzw]

Thank you very much, that fixed my problem.

However, I do have one question yet to be answered.

How can I prevent duplicate number entries, but allow duplicate tex
entries

 

[Bob Phillips]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngTest As Range
Dim newVal

Set rngTest = Me.Range("A1:A100")
On Error GoTo ws_exit:
Application.EnableEvents = False
If Not Intersect(Target, rngTest) Is Nothing Then
With Target
If IsNumeric(.Value) Then
If WorksheetFunction.CountIf(rngTest, .Value) > 1 Then
newVal = .Value
.Value = ""
MsgBox "Duplicate - already on row " & _
WorksheetFunction.Match(newVal, rngTest, 0)
End If
End If
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)