Prevent duplicate IF left string is repeating

[NAP2012]

C1-a
C1-b
C1	prevent
C2
C2-a	prevent

<tbody>
</tbody>

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]

Hi Robert, this seems very near...except its allowing the same C18 in this example if I enter with dash.

Record #	ID
1	C10-a
2	C10-b
3	C10-c
4	C10-d
5	C11
6	C12
7	C13
8	C14
9	C15
10	C16
11	C17
12	C18
13	C18-a

<tbody>
</tbody>

row number 13 should have not been allowed as C18 exist before, so user need to start with next number or the one which does not exist without dash.
user can enter enter the same number again only if the same number exist with dash like C10-d, so I can enter C10-e.

see the further explanation i posted in the thread above.

 

[Trebor76]

Maybe this:

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
            
    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)")
        Else
            strMyKey = Target.Value
        End If
        lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row
        For Each rngMyCell In Range("A1:A" & lngLastRow)
            If rngMyCell.Address <> Target.Address Then
                If Left(rngMyCell, Len(strMyKey)) = strMyKey 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 For
                End If
            End If
        Next rngMyCell
    End If

End Sub

 

[NAP2012]

C10-e

<tbody>
</tbody>

If I enter C10-e its not allowing that.

 

[Trebor76]

In post 11 you said not to allow C18-a so why is C10-e ok?

 

[Trebor76]

Let me know how this goes and if it's wrong why:

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
        lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row
        If InStr(Target.Value, "-") > 0 Then
            dblMyCount = WorksheetFunction.CountIf(Range("A1:A" & lngLastRow), Target.Value)
            If dblMyCount = 1 Then
                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
        End If
        'If we get here the ID has been entered without a dash so check all entries against it to ensure it hasn't been used
        For Each rngMyCell In Range("A1:A" & lngLastRow)
            If rngMyCell.Address <> Target.Address Then
                If Left(rngMyCell, Len(Target.Value)) = Target.Value Then
                    MsgBox "To use """ & Target.Value & """ you will need to add a dash to it as well as the next letter for that range." & vbNewLine & "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

 

[NAP2012]

In post 11 you said not to allow C18-a so why is C10-e ok?

because C18 without dash exist. While C10 without dash does not exist.

your code is working all fine except its allowing dash entry for the same (C18 in example) number.

Record #	Req.
C10-a	exist
C10-b	exist
C10-c	exist
C10-d	exist
C10	should not allowed
C18	exist
c18-a	should not allowed

<tbody>
</tbody>

To satisfy the requirement if I can rephrase to simplify...

• If I am entering number with dash, (e.g. C18-a)
  • the same number without dash should not exist before (C18)
  • and exact same number with dash should also not exist before (C18-a)

• If I am entering number without dash, (e.g. C10)
  • same number with dash should not exist before (C10-a/b/c...)
  • the exact same number (without dash) should not exist before (C10)

 

[Trebor76]

OK - last attempt:

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
    Dim rngMyRange As Range
    
    'Code built to only work on a single cell in Col. A
    'Adapted from here https://www.mrexcel.com/forum/excel-questions/651154-vba-worksheet_change-event-how-detect-if-multiple-cells-were-selected.html
    Set rngMyRange = Intersect(Target, Range("A:A"))
    If Not rngMyRange Is Nothing Then
        If rngMyRange.Cells.Count > 1 Then
            Exit Sub
        End If
    End If
            
    If Target.Column = 1 And Len(Target.Value) > 0 Then
        lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row
        dblMyCount = WorksheetFunction.CountIf(Range("A1:A" & lngLastRow), Target.Value)
        'If the entry has been duplicated, then...
        If dblMyCount > 1 Then
            '...inform the user, clear the entry and quit
            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
        If InStr(Target.Value, "-") > 0 Then
            strMyKey = Evaluate("LEFT(""" & Target.Value & """,FIND(""-"",""" & Target.Value & """)-1)")
        Else
            strMyKey = Target.Value
        End If
        For Each rngMyCell In Range("A1:A" & lngLastRow)
            If rngMyCell.Address <> Target.Address Then
                If Len(rngMyCell) > 0 Then
                    If Left(rngMyCell.Value, Len(strMyKey)) = strMyKey Then
                        MsgBox "You cannot use " & Target.Value & " as " & strMyKey & " is already in use." & vbNewLine & "Cell " & Target.Address(False, False) & " will be cleared.", vbCritical
                        Application.EnableEvents = False
                            Target.ClearContents
                        Application.EnableEvents = True
                        Exit For
                    End If
                End If
            End If
        Next rngMyCell
    End If

End Sub

Robert