No permitir duplicidad de datos
Sres. T. E.
Tengo el Siguiente Código, el cual no me funciona como lo deseo.
La idea es la siguiente:
No permitir la duplicidad de dados de los primeros Cuatro(4) caracteres, como pueden observar en la instrucción “FindItem = Mid(Target, 1, 4)”
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(ActiveCell, Range("B7:B10")) Is Nothing And Target <> _
Empty Then
FindItem = Mid(Target, 1, 4)
CantItem = Application.WorksheetFunction.CountIf(Sheets("hoja1").Columns( _
2), FindItem)
If CantItem > 1 Then
MsgBox "El código ya existe, No se Acepta duplicidad"
Exit Sub
End If
End If
End Sub
Ok haciendo esto no me funciona, si es posible cambiar la forma de procedimiento estoy de acuerdo.
Anexo Tabla
Columna B
Fila 7 0001 Producto 01
Fila 8 0005 Producto 05
Fila 9 0010 Producto 10
Fila 10 0257 Descripción
1 Respuesta
Prueba lo siguiente.
Ajusta el rango "B7:B10" en la macro por el rango donde quieras verificar.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B7:B10")) Is Nothing Then
If Target.CountLarge > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
'
Dim finditem As String
Dim CantItem As Long
'
finditem = Mid(Target.Value, 1, 4) & "*"
CantItem = Application.WorksheetFunction.CountIf(Range("B7:B10"), finditem)
If CantItem > 1 Then
MsgBox "El código ya existe, No se Acepta duplicidad"
Application.EnableEvents = False
Target.Value = ""
Target.Select
Application.EnableEvents = True
End If
End If
End Sub[Avísame cualquier duda. No olvides la valoración.
