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

Respuesta
2

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

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas