Prevent duplicate IF left string is repeating

[NAP2012]

[TABLE="width: 500, align: left"]
<tbody>[TR]
[TD]C1-a[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]C1-b[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]C1[/TD]
[TD]prevent[/TD]
[/TR]
[TR]
[TD]C2[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]C2-a[/TD]
[TD]prevent[/TD]
[/TR]
</tbody>[/TABLE]









Hi,

I found many posts that have solution to prevent entering duplicate values in a column's cell.
I am trying to solve the same problem which has little different flavor.

In above table I want to stop users if they try to enter the same value (before "-").
E.G. A1-a if already there, A1 should not be allowed.

Essentially, the logic should first...
run this formula "=LEFT(C1,FIND("-",C1)-1)"
then run the list validation using countif.

I am using the folloiwng line of vb code but don't know how do i add the LEFT formula component to it or update the code to prevent duplicate comparing string before "-" i.e. dash.

Private Sub Worksheet_Change(ByVal Target As Range)
If Application.CountIf(Range("a:a"), Target) > 1 Then
    MsgBox "Duplicate....", vbCritical, "Can't take dups :("
    'what this should do after the error msg is closed
       Target.Value = ""
End If
End Sub

 

[NAP2012]

Anyone expert on this problem?

 

[Trebor76]

Hi NAP2012,

Welcome to MrExcel!!

Try this for checking column A (not sure why but your formula was using cell C1 ):

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim objMyUniqueData As Object
    Dim rngMyCell As Range
    Dim strMyKey As String

    If Target.Column = 1 Then
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With
        Set objMyUniqueData = CreateObject("Scripting.Dictionary")
        For Each rngMyCell In Range("A1:" & Target.Address)
            If Len(rngMyCell) > 0 And InStr(rngMyCell, "-") > 0 Then
                strMyKey = Evaluate("LEFT(""" & rngMyCell.Value & """,FIND(""-"",""" & rngMyCell.Value & """)-1)")
                If objMyUniqueData.Exists(strMyKey) = False Then
                    objMyUniqueData.Add strMyKey, CStr(strMyKey)
                Else
                    MsgBox "Duplicates are not allowed." & vbNewLine & "As such the entry in cell " & Target.Address(False, False) & " will be cleared.", vbCritical
                    Target.ClearContents
                    Exit For
                End If
            End If
        Next rngMyCell
        Set objMyUniqueData = Nothing
        With Application
            .EnableEvents = True
            .ScreenUpdating = True
        End With
    End If

End Sub

Also my code won't allow C1-b but you haven't flagged it as a duplication??

Regards,

Robert

 

[lrobbo314]

Try this...

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim LR As Long: LR = Range("A" & Rows.Count).End(xlUp).Row()
If LR = 1 Then Application.EnableEvents = True: Exit Sub
Dim r As Range: Set r = Range("A1:A" & LR)
Dim AR() As Variant: AR = r.Value
Dim AL As Object: Set AL = CreateObject("System.Collections.ArrayList")
Dim aVal As String: aVal = vbNullString
Dim tVal As String: tVal = Target.Value


If InStr(tVal, "-") > 0 Then tVal = Left(tVal, InStr(tVal, "-") - 1)


For i = LBound(AR) To UBound(AR)
    aVal = AR(i, 1)
    If InStr(aVal, "-") > 0 Then
        If Not AL.contains(Left(aVal, InStr(aVal, "-") - 1)) Then AL.Add Left(aVal, InStr(aVal, "-") - 1)
    Else
        If Not AL.contains(AR(i, 1)) Then AL.Add AR(i, 1)
    End If
Next i


If AL.contains(tVal) Then
    MsgBox "Cannot Create Duplicate"
    Target = vbnullsting
End If


Application.EnableEvents = True
End Sub

 

[NAP2012]

[QUOTE
Try this for checking column A (not sure why but your formula was using cell C1 ):
[/QUOTE]
My bad, I had values in col c in my test file hence.

The code seems finding any new value as duplicate even if I am entering new value which does not exist pre "-".

[TABLE="width: 64"]
<colgroup><col width="64" style="width:48pt"> </colgroup><tbody>[TR]
[TD="class: xl66, width: 64"]COL-A[/TD]
[/TR]
[TR]
[TD="class: xl67"]C10-a[/TD]
[/TR]
[TR]
[TD="class: xl67"]C10-b[/TD]
[/TR]
[TR]
[TD="class: xl67"]C10-c[/TD]
[/TR]
[TR]
[TD="class: xl67"]C10-d[/TD]
[/TR]
[TR]
[TD="class: xl67"]C11[/TD]
[/TR]
[TR]
[TD="class: xl67"]C12[/TD]
[/TR]
[TR]
[TD="class: xl67"]C13[/TD]
[/TR]
[TR]
[TD="class: xl67"]C14[/TD]
[/TR]
[TR]
[TD="class: xl67"]C15[/TD]
[/TR]
[TR]
[TD="class: xl67"]C16[/TD]
[/TR]
[TR]
[TD="class: xl67"]C17[/TD]
[/TR]
[TR]
[TD="class: xl67"]C18[/TD]
[/TR]
</tbody>[/TABLE]

for example in the above col a, If I enter C19 it finds it as duplicate.
To clarify further, there are two scenario possible...

scenario 1: User enters value without "-"
1. In this case, the code should check all the existing cells' value prior to "-" if dash is there and where the value has no dash check those too to find uniqueness.
e.g. we do first text to column for delimiter "-" and then compare all for uniqueness.

2. If I enter C10, it should check C10-a, C10-b,C10-c,C10-d without "-" and all other values where there is no dash in it. As C10 without dash is there, it should not allow C10.



scenario 2: User enters value with "-"
In this case,

1. it should check the existing values with "-" If there is one with "-" then check in entirety for uniqueness.
- e.g. C10-e is not there so allowed.

2. as i am entering dash value, it should check if same number with non dash is not there.
- e.g. If I enter C18-a, it should check if C18 is there, as this is there, not allowed.

Basically we want to force data integrity in a way that if you need to break down a component with dash then that value should not have non dashed element in it. i.e. if C18 needs to have a,b,c....all C18 needs to be dashed hence C18 without dash is not allowed.

 

[NAP2012]

thanks Robert, code seems to find all new values as duplicate, see my reply in this thread with further info.

 

[NAP2012]

Thanks, lrobbo314.
code seems to find all new values as duplicate, see my reply in this thread with further info.

 

[lrobbo314]

1. it should check the existing values with "-" If there is one with "-" then check in entirety for uniqueness.
- e.g. C10-e is not there so allowed.

I don't understand. If you can enter C10-a, C10-b, C10-c, and C10-d, then why would it block C10-e?

 

[Trebor76]

I must say I'm a little confused too, but see how this goes:

Option Explicit
Option Compare Text 'Compare text but ignore case sensitivity
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim strMyKey As String
    Dim lngLastRow As Long
    Dim rngMyCell As Range
    Dim dblMyCount As Double
        
    If Target.Column = 1 And Len(Target.Value) > 0 Then
        If InStr(Target.Value, "-") > 0 Then
            strMyKey = Evaluate("LEFT(""" & Target.Value & """,FIND(""-"",""" & Target.Value & """)-1)")
        End If
        lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row
        dblMyCount = WorksheetFunction.CountIf(Range("A1:A" & lngLastRow), Target.Value)
        If dblMyCount = 1 And Len(strMyKey) > 0 Then
            Exit Sub
        ElseIf dblMyCount > 1 And Len(strMyKey) > 0 Then
            MsgBox Target.Value & " has already been entered." & vbNewLine & "As such cell " & Target.Address(False, False) & " will be cleared.", vbCritical
            Application.EnableEvents = False
                Target.ClearContents
            Application.EnableEvents = True
            Exit Sub
        ElseIf dblMyCount > 1 Then
            MsgBox Target.Value & " has already been entered." & vbNewLine & "As such cell " & Target.Address(False, False) & " will be cleared.", vbCritical
            Application.EnableEvents = False
                Target.ClearContents
            Application.EnableEvents = True
            Exit Sub
        End If
        For Each rngMyCell In Range("A1:A" & lngLastRow)
            If rngMyCell.Address <> Target.Address Then
                If Left(rngMyCell, Len(Target.Value)) = Target.Value Then
                    MsgBox Target.Value & " has already been entered as part of another cell." & vbNewLine & "As such cell " & Target.Address(False, False) & " will be cleared.", vbCritical
                    Application.EnableEvents = False
                        Target.ClearContents
                    Application.EnableEvents = True
                    Exit For
                End If
            End If
        Next rngMyCell
    End If

End Sub

Robert

 

[NAP2012]

I don't understand. If you can enter C10-a, C10-b, C10-c, and C10-d, then why would it block C10-e?

apology If I confused.
C10-e should be allowed, not blocked.
if the user enters only C10 then the code should have blocked as the C10 series has been taken already.

The reason we have this weird numbering is...user enters requirement in the excel and gives incremental numbering starting with an alphabet which is associated with a project.
when some requirement though its a one requirement, it has multiple component. e.g.

C9 = give the background yellow color. (only one component so no dash added by user)

C10-a = update a report with xyz column (UI component)
C10-b = add xyz column in db table (db component)

Now if there is a next requirement, we don't want user to take C10 again as its taken already.
but let's say for the above C10-* if an additional component is added, than it should allow the next entry with dash, e.g...
C10-c = Highlight the column xyz in red.