PDA

View Full Version : Solved: Prevent duplicate data entry?



Gingertrees
06-03-2009, 12:39 PM
Hello,
Users will enter clients in the "Cases" tab, and these are indexed by the URN, a unique combination of letters and numbers. AAAA1122331, or BOOO0130802 would be fictional examples. How can I assure that the user, while entering his/her data, does not create a duplicate entry? There are plenty of examples of ways of finding duplicate data that already exists - I want to prevent it to begin with.

For example, if I enter these three clients in the workbook:
AAAA1122331
BBBB0202222
CCCC1010682

And I try to enter
AAAA1122331 again in a new cell (row), I would like an error message to appear as soon as I try to navigate away from that cell.
Ideas?

tpoynton
06-03-2009, 01:05 PM
I'm a data validation newbie myself, but this should work in a custom data validation, assuming the data are in column A and start with A1:

=COUNTIF(A:A, A1)<2

mdmackillop
06-03-2009, 01:28 PM
Use Conditional Formatting with formula =COUNTIF(A:A,A1)>1
This will highlight both cells if duplicate is entered.

Gingertrees
06-03-2009, 01:30 PM
OK, the highlighting thing works. Any way I can have an error message pop up so user knows without a shadow of doubt that they goobered it up?

~Ginger

GTO
06-03-2009, 02:02 PM
Greetings Ginger,

Maybe?

In the Worksheet's Module:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngWhole As Range
Dim rngLastCell As Range


If Not Application.Intersect(Target, Range("A2:A" & Rows.Count)) Is Nothing _
And Not Target.Count > 1 Then

Set rngLastCell = Range("A:A").Find(What:="*", _
After:=Range("A1"), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious)
If Not rngLastCell Is Nothing Then

If rngLastCell.Address(False, False) = "A2" Then Exit Sub

Set rngWhole = Range("A2", rngLastCell)

If Application.WorksheetFunction.CountIf(rngWhole, Target) > 1 Then
MsgBox "Duplicate at " & Target.Address(False, False) & " cleared.", 0, ""
Target.ClearContents
End If

End If
End If
End Sub


Hope this helps,

Mark

mdmackillop
06-03-2009, 02:04 PM
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 1 Then Exit Sub
If Application.CountIf(Target.EntireColumn, Target.Text) > 1 Then
MsgBox "You've goobered it up!"
End If
End Sub

Gingertrees
06-03-2009, 04:46 PM
Hmm, strangely neither of those routines appeared to do anything. Perhaps the code I already have in there is interfering? I know it's set to kill a few of Excel's natural reactions, maybe it includes a pop-up blocker, too. Mdmckillop and GTO, you'll recognize this (thanks to both of you for stringing together the parts I didn't understand!):

' MODULE: ThisWorkbook
Option Explicit
'passwords for most sheets "cap", backgrd="CAP"

Dim bolMyOverride As Boolean

'// BeforeClose and Open remain as you had them, as do the proedures 'HideSheets' and //
'// 'UnhideSheets'. //
Private Sub Workbook_BeforeClose(Cancel As Boolean)
With Application
.EnableCancelKey = xlDisabled
.ScreenUpdating = False
Call HideSheets
.ScreenUpdating = True
.EnableCancelKey = xlInterrupt
End With
End Sub

Private Sub Workbook_Open()
'this is located in the ThisWorkbook module
With Application
'disable the ESC key
.EnableCancelKey = xlDisabled
.ScreenUpdating = False
Call UnhideSheets
.ScreenUpdating = True
're-enable ESC key
.EnableCancelKey = xlInterrupt
End With

End Sub


Private Sub Workbook_Activate()

'// After you have run 'EnableStuffSoICanWork()', then the Boolean 'bolMyOverride' //
'// equals TRUE. //

'// So... assuming you've run the aforementioned sub and bolMyOverride has been set //
'// to True, the below test fails, and 'CutCopy_Disable' is never called. In short,//
'// as long as bolMyOverride retains a value of True, you can make mods w/o //
'// interference, as long as you don't reset. //
If Not bolMyOverride Then
'// Code moved to own sub //
Call CutCopy_Disable
End If
End Sub

Private Sub Workbook_Deactivate()

'// SAA //
If Not bolMyOverride Then
Call CutCopy_Enable
End If
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

If Not bolMyOverride Then
With Application
.CellDragAndDrop = False
.CutCopyMode = False 'Clear clipboard
End With
End If

End Sub


Private Sub EnableStuffSoICanWork()
Call CutCopy_Enable
bolMyOverride = True
End Sub

Private Sub DisableStuffSoOthersCannotGooberUpMyDay()
Call CutCopy_Disable
bolMyOverride = False
'// Optional of course //
ThisWorkbook.Save
End Sub

Private Sub CutCopy_Disable()
Dim oCtrl As Office.CommandBarControl

'Disable all Cut menus
For Each oCtrl In Application.CommandBars.FindControls(ID:=21)
oCtrl.Enabled = False
Next oCtrl

'Disable all Copy menus
For Each oCtrl In Application.CommandBars.FindControls(ID:=19)
oCtrl.Enabled = False
Next oCtrl

Application.CellDragAndDrop = False
End Sub

Private Sub CutCopy_Enable()
Dim oCtrl As Office.CommandBarControl

'Enable all Cut menus
For Each oCtrl In Application.CommandBars.FindControls(ID:=21)
oCtrl.Enabled = True
Next oCtrl

'Enable all Copy menus
For Each oCtrl In Application.CommandBars.FindControls(ID:=19)
oCtrl.Enabled = True
Next oCtrl

Application.CellDragAndDrop = True
End Sub

Private Sub HideSheets()
'
Dim Sheet As Object '< Includes worksheets and chartsheets
'
With Sheets("Prompt")
'
'the hiding of the sheets constitutes a change that generates
'an automatic "Save?" prompt, so IF the book has already
'been saved prior to this point, the next line and the lines
'relating to .[A100] below bypass the "Save?" dialog...
' If ThisWorkbook.Saved = True Then .[A100] = "Saved"
'
.Visible = xlSheetVisible
'
For Each Sheet In Sheets
If Not Sheet.Name = "Prompt" Then
Sheet.Visible = xlSheetVeryHidden
End If
Next
'
If .[A100] = "Saved" Then
.[A100].ClearContents
ThisWorkbook.Save
End If
'
Set Sheet = Nothing
End With
'
End Sub

Private Sub UnhideSheets()
'
Dim Sheet As Object
'
For Each Sheet In Sheets
If Not Sheet.Name = "Prompt" Then
Sheet.Visible = xlSheetVisible
End If
Next
'
Sheets("Prompt").Visible = xlSheetVeryHidden
'
' Application.Goto Worksheets(1).[A1], True '< Optional
'
Set Sheet = Nothing
ActiveWorkbook.Saved = True

End Sub

Kenneth Hobs
06-03-2009, 05:06 PM
Is a custom Data > Validation, method off the table? If not, the formula is =COUNTIF($A:$A,$A1)<=1. You can copy and Edit > Paste Special > Validation to copy the validation formula in A1 to others in column A. Be sure to add the Error message and enable it.

See this link if you need more details about this method. http://www.contextures.com/xlDataVal07.html

Using both Data Validation and Conditional Formatting methods works nicely. Use the Format Painter to copy Conditional Formatting. Of course there are cases where the sheet's Change event method is best. Or maybe even a combination of all 3 methods.

Gingertrees
06-03-2009, 07:03 PM
Is a custom Data > Validation, method off the table?
Unfortunately yes, I'm already using data validation to limit text length for that field.

Kenneth Hobs
06-03-2009, 07:15 PM
You can use AND() in a Data Validation formula to check both conditions.

So, if the Change event is your preferred method then where is it in your code? Right click the sheet's tab, View Code and paste mdmackillop's 2nd code example.

Obvisously, you would need to delete the value or re-enter it for the user and put it in editmode. Example deleting the duplicate entry:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 1 Then Exit Sub
If Application.CountIf(Target.EntireColumn, Target.Value) > 1 Then
MsgBox "Duplicate data has been deleted, retry."
Application.EnableEvents = False
Target.ClearContents
Target.Select
Application.EnableEvents = True
End If
End Sub



Of course I only checked one changed cell. If you copy more than one cell, other code is needed. However, that should not be an issue if your code does disable paste.

GTO
06-03-2009, 07:32 PM
Hmm, strangely neither of those routines appeared to do anything. Perhaps the code I already have in there is interfering?

Hi Ginger,

Probably a bit moot as Ken's suggestion seems keen to me, but just to address, Malcom's or my code needs to be under the sheet its designed to react to. Right-click the sheet tab and select View to get to the sheet's module.

If going with code, I'd certainly select Malcom's. (Jeepers! I knew mine was probably a wee bit longer than necessary... Where's the blushing smiley?)

Mark

Edit: Hi Ken

Sorry, I hadn't read your clarifying as to sheet's module.

I noticed that Malcom used .Text rather than .Value. In either case, I was thinking that...
If Target.Column <> 1 Or Target.Count > 1 Then Exit Sub could prevent an error (or unwanted popup of msg if using .Text) if clearing contents of multiple cells?

mdmackillop
06-03-2009, 11:26 PM
Hi Gingertrees,
Perhaps you should consider a UserForm to allow the users to enter data, This allows validation before the data gets to the sheet, and ensures the data goes to the correct columns. It can also protect excisting data from accidental change/deletion. This is the basis for most database entry.

Kenneth Hobs
06-04-2009, 06:16 AM
GTO, I would use the TEXT property if I wanted numeric formats to govern. Typically, I use the Value property. It just depends on the data. Using the Count > 1 is one route but it should not be need if Paste is actually disabled. If not, we can always modify the code and not exit the Sub but handle that scenario as well. Ginger needs to respond if that sort of help is needed.

I would guess that Ginger's needs should be met by use of the Change event.

Gingertrees
08-19-2009, 07:20 AM
OK users didn't "notice" the conditional formatting, so I want to try the combined data val.

Goals:
1) prevent duplicate data entry
2) limit length between 11 and 14 characters

Custom data val for column A (A5:A204):
=(COUNTIF(A:A,A5)=1 & LEN(A5)>10 & LEN(A5)<15)

Problem: it doesn't work. I can get it to trigger ALL the time, or if I remove 1 condition (so it's just CountIf and Length>10) it NEVER triggers.
:banghead: :banghead: :banghead:
help?

mdmackillop
08-19-2009, 10:52 AM
Try
=AND(COUNTIF($A$5:$A$204,$A5)=1,LEN($A5)>10,LEN($A5)<15)

Gingertrees
08-19-2009, 11:46 AM
Perfecto! Thanks a lot. :-)