Evitar insertar valor duplicado en una celda VBA Macro

tengo el siguiente form

Cuando doy al botón guardar me inserta una fila con los datos que llene previamente en este formulario:

El excel se ira llenando de datos guardados, lo que quiero es que al momento de guardar el campo que dice UPC, su valor no se duplique, en este caso que me muestre un mensaje "Error. La UPC ya fue previamente escaneada" y que no se guarde en el Excel.

El código que tengo en el btn_guardar es el siguiente:

Private Sub btn_guardar_Click()
        If esc_upc & lista_def = Empty Then
                MsgBox "VERIFICAR QUE LOS CAMPOS ESTEN LLENOS", vbOKOnly, "CAMPOS VACIOS"
                esc_upc.SetFocus
                DEFNOMBRE = Clear 
            Else
        ActiveSheet.Cells(2, 1).Select
        Selection.EntireRow.Insert
            ActiveSheet.Cells(2, 1) = esc_upc
            ActiveSheet.Cells(2, 2) = esc_corte
            ActiveSheet.Cells(2, 3) = esc_bulto
            ActiveSheet.Cells(2, 4) = esc_pieza
            ActiveSheet.Cells(2, 5) = esc_fecha
            ActiveSheet.Cells(2, 6) = lista_def
            ActiveSheet.Cells(2, 7) = txt_planta
            ActiveSheet.Cells(2, 8) = txt_modulo
            ActiveSheet.Cells(2, 9) = txt_turno
            ActiveSheet.Cells(2, 10) = txt_auditor
        esc_upc = Empty
        esc_corte = Empty
        esc_bulto = Empty
        esc_pieza = Empty
        DEFNOMBRE = Empty
        esc_upc.SetFocus
        lista_def.ListIndex = -1
       End If

1 respuesta

Respuesta
1

Una forma sencilla de hacer la validación es por medio de un objeto collection, este validara cualquier dato que ingreses y si esta repetido te enviara un mensaje.

Private Sub btn_guardar_Click()
Dim UNICOS As New Collection
Set DATOS = Range("A1").CurrentRegion
With DATOS
    For i = 2 To .Rows.Count
        CODIGO = .Cells(i, 1)
        On Error Resume Next
            UNICOS.Add CODIGO, CStr(CODIGO)
        On Error GoTo 0
    Next i
    CODIGO = ESC_UPC
    On Error Resume Next
        UNICOS.Add CODIGO, CStr(CODIGO)
            If Err.Number > 0 Then MsgBox ("Error. La UPC ya fue previamente escaneada"), vbInformation, "AVISO": GoTo SALIDA
    On Error GoTo 0
End With
        If ESC_UPC & lista_def = Empty Then
                MsgBox "VERIFICAR QUE LOS CAMPOS ESTEN LLENOS", vbOKOnly, "CAMPOS VACIOS"
                ESC_UPC.SetFocus
                DEFNOMBRE = Clear
            Else
        ActiveSheet.Cells(2, 1).Select
        Selection.EntireRow.Insert
            ActiveSheet.Cells(2, 1) = ESC_UPC
            ActiveSheet.Cells(2, 2) = esc_corte
            ActiveSheet.Cells(2, 3) = esc_bulto
            ActiveSheet.Cells(2, 4) = esc_pieza
            ActiveSheet.Cells(2, 5) = esc_fecha
            ActiveSheet.Cells(2, 6) = lista_def
            ActiveSheet.Cells(2, 7) = txt_planta
            ActiveSheet.Cells(2, 8) = txt_modulo
            ActiveSheet.Cells(2, 9) = txt_turno
            ActiveSheet.Cells(2, 10) = txt_auditor
        ESC_UPC = Empty
        esc_corte = Empty
        esc_bulto = Empty
        esc_pieza = Empty
        DEFNOMBRE = Empty
        ESC_UPC.SetFocus
        lista_def.ListIndex = -1
       End If
SALIDA:
Set DATOS = Nothing: Set UNICOS = Nothing
End Sub

Otra opción es la función contar. Si si ya existe entonces devolverá una cantidad mayor a 0 que una condicional if se encarga de no dejar que ningún dato se grabe en la hoja, esta opción es más rápida que la anterior.

Private Sub btn_guardar_Click()
Set DATOS = Range("A1").CurrentRegion
With DATOS
    busca = WorksheetFunction.CountIf(.Columns(1), esc_upC)
    If busca > 0 Then
        MsgBox ("Error. La UPC ya fue previamente escaneada"), vbInformation, "AVISO": GoTo SALIDA
End If
End With
        If esc_upC & lista_def = Empty Then
                MsgBox "VERIFICAR QUE LOS CAMPOS ESTEN LLENOS", vbOKOnly, "CAMPOS VACIOS"
                esc_upC.SetFocus
                DEFNOMBRE = Clear
            Else
        ActiveSheet.Cells(2, 1).Select
        Selection.EntireRow.Insert
            ActiveSheet.Cells(2, 1) = esc_upC
            ActiveSheet.Cells(2, 2) = esc_corte
            ActiveSheet.Cells(2, 3) = esc_bulto
            ActiveSheet.Cells(2, 4) = esc_pieza
            ActiveSheet.Cells(2, 5) = esc_fecha
            ActiveSheet.Cells(2, 6) = lista_def
            ActiveSheet.Cells(2, 7) = txt_planta
            ActiveSheet.Cells(2, 8) = txt_modulo
            ActiveSheet.Cells(2, 9) = txt_turno
            ActiveSheet.Cells(2, 10) = txt_auditor
        esc_upC = Empty
        esc_corte = Empty
        esc_bulto = Empty
        esc_pieza = Empty
        DEFNOMBRE = Empty
        esc_upC.SetFocus
        lista_def.ListIndex = -1
       End If
SALIDA:
Set DATOS = Nothing: Set UNICOS = Nothing
End Sub

¡Muchas Gracias James Bond! era justo lo que necesitaba. ya vote por tu respuesta como excelente.

James, que se le agregaría al código para que al momento que salga el mensaje de la upc ya escaneada, darle aceptar y que me borre el contenido de esc_upc y darle un SetFocus. Espero y me puedas ayudar.

Tu misma te has dado la respuesta y es la siguiente para ambas opciones

 If busca > 0 Then
    MsgBox ("Error. La UPC ya fue previamente escaneada"), vbInformation, "AVISO"
    with esc_upc
       .text=empty
       .setfocus
    end with
    goto salida
endif
End If

¡Gracias! Y corrección man, soy hombre. haha

Saludos y muchas gracias de nuevo bro!

Mis disculpas por la confusión se me quedo en la memoria el nombre de una usuaria a la que previamente conteste

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas