Forward not Backwards

[kev6264]

I have this procedure that works great, but if I select a two-letter code in a cell that precedes another cell, the procedure allows the duplicate. How can I turn this into a forward and backwards checker?

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Target.Column <> 4 Then Exit Sub
    If Application.WorksheetFunction.CountIf(Range("$D$2:$D" & Target.Row), Target) > 1 Then
        MsgBox "You have chosen a duplicate sine. Please try again"
        Application.EnableEvents = False
        Application.Undo
        Application.EnableEvents = True
    End If
End Sub

 

[erik.van.geit]

Hi,

try this

Private Sub Worksheet_Change(ByVal Target As Range)
Dim LR As Long
LR = Cells(Rows.Count, 4).End(xlUp).Row

    If Target.Count > 1 Then Exit Sub
    If Target.Column <> 4 Then Exit Sub
    If Application.WorksheetFunction.CountIf(Range("$D$2:$D" & LR), Target) > 1 Then
';;;

kind regards,
Erik

 

[kev6264]

Nope, it now gives me a duplicate even if there is none.

 

[erik.van.geit]

works for me in column 4

 

[kev6264]

Should I replace the entire procedure with what you created? Or just insert before the

MsgBox "You have chosen a duplicate sine. Please try again"
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
End If
End Sub

 

[erik.van.geit]

without End Sub it's never gonna work

I had just pasted the first part - which was the condition - since the rest was the same - action part

 

[kev6264]

Erik

I pasted it and it still only checks up not down. Please excuse my ignorance..

 

[erik.van.geit]

I wouldn't know what can go wrong then some simple mistake, unless I'm missing something very obvious ...
It's working fine for me and it is not complicated at all.

what is the code you are using ???
it should read

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim LR As Long
LR = Cells(Rows.Count, 4).End(xlUp).Row

    If Target.Count > 1 Then Exit Sub
    If Target.Column <> 4 Then Exit Sub
    
    If Application.WorksheetFunction.CountIf(Range("$D$2:$D" & LR), Target) > 1 Then
    MsgBox "You have chosen a duplicate sine. Please try again"
    Application.EnableEvents = False
    Application.Undo
    Application.EnableEvents = True
    End If

End Sub

is it in the correct sheetmodule ?
perhaps you've still your old code in the sheetmodule and pasted the new code to the wrong sheetmodule

what popup do you get when you put this line after the line
LR = ...

MsgBox LR

best regards,
Erik

 

[kev6264]

a Msgbox with a zero in it.

 

[kev6264]

I copied and pasted your code word for word and now it doesn't allow any two-letter combo. I inserted the MsgBox LR and it replies 2512.

Is there a way to insert my spreadsheet so you can see it happen? Thanks for being so patient Erik.

kevin