Detectar duplicados y eliminarlos devolviendo un mensaje de aviso
Tengo la necesidad de validar una columna para los numeros de lote de mi producto la idea es q si se ingresa un valor repetido me avise y lo elimine
Buscando un poco encontre este codigo que la verdad si me funciona
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
Contenido = Target
If WorksheetFunction.CountIf(Range("A1:A65536"), Contenido) > 1 Then
MsgBox "El numero de lote que intenta capturar ya existe", vbOKOnly, "Duplicado"
Application.Undo
End If
End If
End Sub
Pero el problema es que mi usuario siempre copia y pega informacion por lo que necesito que si borra dos o 3 registros o los corta no afecte el funcionamiento que ya se hace lo mismo pasa si pega mas de un registro, es por eso que pido su ayuda ya que la verdad no se me ocurre como hacerlo.
1 Respuesta
Te anexo la macro actualizada
Private Sub Worksheet_Change(ByVal Target As Range)
'Act.Por.Dante Amor
If Target.Column = 1 Then
On Error Resume Next
Set rango = Target.SpecialCells(xlCellTypeConstants, 23)
werr = Err.Number
On Error GoTo 0
If werr <> 0 Then Exit Sub
For Each c In Target.SpecialCells(xlCellTypeConstants, 23)
If c.Column = 1 Then
If WorksheetFunction.CountIf(Range("A1:A" & Rows.Count), c.Value) > 1 Then
MsgBox "Ya existe el numero de lote : " & c.Value, vbExclamation, "Duplicado"
Application.EnableEvents = False
c.Value = ""
Application.EnableEvents = True
End If
End If
Next
End If
End Sub
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
