No Duplications

[srizki]

I have to type a an ID in column D of a worksheet called “restricted funds”, I have 13 sheets in that workbook and each sheet has in column D some IDs, I can not type a duplicate ID, in the that sheet. What is the best way to avoid no duplications. IDs are simply numbers.<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o> </o>
Thanks

 

[erik.van.geit]

you're welcome!!!

instead of putting the code in all sheets, you can put it in the workbook module - with little changes

is it all sheets without exceptions?
else list the exceptions please

 

[srizki]

Thanks Erik,

There are no exceptions. I want to use the code in ThisWorkbook module.

 

[erik.van.geit]

delete all similar code in all sheet modules
put this in the workbook module

Option Explicit
 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'Erik Van Geit
'080624 2313
'no duplicates allowed on this sheet or other sheets
'within the range "RngAddress"
'multiple changes within range not allowed, unless clearing data
 
Dim sht As Worksheet
Dim dup As Range
Dim RngAddress As String
Dim msg As String
 
RngAddress = "D1:D" & Rows.Count     'range to check
 
    If Intersect(Target, Range(RngAddress)) Is Nothing Then Exit Sub
 
    If Application.CountA(Target) = 0 Then Exit Sub
    If Target.Count > 1 Then
    msg = "Please change only one item at a time in the range " & RngAddress
 
    Else
 
        For Each sht In ThisWorkbook.Worksheets
            If sht.Name <> Sh.Name Then
            Set dup = sht.Range(RngAddress).Find(What:=Target, LookIn:=xlFormulas, LookAt:=xlWhole)
                If Not dup Is Nothing Then
                msg = "The item """ & Target & """ can be found on sheet """ & sht.Name & """ in cell " & dup.Address(0, 0)
                Exit For
                End If
            Else
                If Application.CountIf(sht.Range(RngAddress), Target) > 1 Then
                msg = "The item """ & Target & """ is already in the list on this sheet."
                Exit For
                End If
            End If
        Next sht
 
    End If
 
    If Len(msg) > 0 Then
        With Application
        .EnableEvents = False
        .Undo
        .EnableEvents = True
        End With
    MsgBox msg, vbCritical, "ERROR"
    End If
 
End Sub

 

[srizki]

Erik, Thank you very much.

 

[srizki]

It worked perfectly. If I were to use it on other wb. the only change I will make is "D1:D", is that right? Erik.

Thanks

 

[erik.van.geit]

try it

 

[srizki]

Oh Yes, Erik, I changed D to M and it worked, If I do not want duplicate in a range other than a column, can I put range such as D4:K32?
I have not tried yet, but that would be a plus too.

Thanks

 

[erik.van.geit]

Yes, the code is flexible: you can adapt the range address easily.

 

[srizki]

that was great help Erik, I learned something new the next thing is I have to understand the coding.
Thank you very much.

Regards
Sohail.