Macro que indique que dato no existe en otro libro

Necesito una macro que al ingresar un dato en un libro excel, me indique que no existe en otro especifico y por ende no pueda ingresarlo ya que tengo que ingresarlo en el libro (madre) por así decirlo.

LA carpeta tiene 15 archivos excel y uno de ellos es el libro madre que se llama cargar_rendir.xls donde ingreso la base de datos en el cual de los mismos datos los ingreso en las demás carpetas dependiendo a quien le asigne el documento con el código de barras.

Lo que quiero es que al ingresar la base de datos en el excel "madre" en algún descuido puede que haya un documento que no esté en la base de datos y que al ingresarlo en uno de los otros libros excel me indique con un mensaje que dicho documento no está asignado a la sala y no se pueda ingresar: yo tengo este código pero funciona dentro del mismo libro.

______________________________________________________________________________________

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Columns("B")) Is Nothing Then
If Target = "" Then Exit Sub
Set b = Sheets("carga").Columns("B").Find(Target, LookAt:=xlWhole)
If b Is Nothing Then
MsgBox "Documento no existe en CARGA" & vbCr & vbCr & _
" " & Target, vbCritical, "VERIFICAR CÓDIGO"
Target.Select
Target.ClearContents
End If
End If
If Target.Column = 2 Then
valor = Target.Value
contarsi = Application.WorksheetFunction.CountIf(Columns(2), valor)
If contarsi > 1 Then
MsgBox "dato duplicado, se eliminará"
Target.Select
Target.ClearContents
Target.Offset(0, 1).ClearContents
End If
End If
End Sub

__________________________________________________________________________

Algo parecido pero acá necesito que busque desde un libro a otro que es el libro "madre", solamente que indique que dicho dato no existe al ingresarlo y lo elimine, que no quede "grabado"

La dirección de la carpeta donde están los libros excel es: D:\correo\correo\

El libro, hoja y el rango donde va la base de datos (madre) se llama: cargar_rendir.xls hoja cargar rango columna B.

Los datos que ingreso en los otros libros van en la columna B hoja cargar.

1 Respuesta

Respuesta
1

H o l a:

Private Sub Worksheet_Change(ByVal Target As Range)
'Act.Por.Dante Amor
    Application.ScreenUpdating = False
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Columns("B")) Is Nothing Then
        If Target = "" Then Exit Sub
        ruta = "D:\correo\correo\"
        'ruta = "C:\trabajo\"
        arch = "cargar_rendir.xls"
        Set l2 = Workbooks.Open(ruta & arch)
        Set h2 = l2.Sheets("carga")
        Set b = h2.Columns("B").Find(Target, LookAt:=xlWhole)
        ThisWorkbook.Activate
        If b Is Nothing Then
            MsgBox "Documento no existe en libro madre, hoja CARGA" & vbCr & vbCr & _
            " " & Target, vbCritical, "VERIFICAR CÓDIGO"
            Target.Select
            Target.ClearContents
        End If
    End If
    If Target.Column = 2 Then
        valor = Target.Value
        contarsi = Application.WorksheetFunction.CountIf(Columns(2), valor)
        If contarsi > 1 Then
            MsgBox "dato duplicado, se eliminará"
            Target.Select
            Target.ClearContents
            Target.Offset(0, 1).ClearContents
        End If
    End If
End Sub

Hola Dante, muchas gracias por tu ayuda, la macro funciona, pero hay un pequeño muy minúsculo problemilla, el asunto es que se abre el libro madre (cargar_rendir), me imagino que debe ser que la macro al abrirlo busca si el código está o no, pero no quiero que se abra, ya que al ingresar varios códigos, en cada uno que ingrese me indica mensaje "libro cargar_rendir (madre) ya se encuentra abierto, si continua puede que pierda la información ... como poder cambiar? si se puede ;) 

saludos!!!

Te anexo la macro actualizada

Private Sub Worksheet_Change(ByVal Target As Range)
'Act.Por.Dante Amor
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Columns("B")) Is Nothing Then
        If Target = "" Then Exit Sub
        'ruta = "D:\correo\correo\"
        ruta = "C:\trabajo\"
        arch = "cargar_rendir.xls"
        Set l2 = Workbooks.Open(ruta & arch, ReadOnly:=True)
        Set h2 = l2.Sheets("carga")
        Set b = h2.Columns("B").Find(Target, LookAt:=xlWhole)
        ThisWorkbook.Activate
        If b Is Nothing Then
            MsgBox "Documento no existe en libro madre, hoja CARGA" & vbCr & vbCr & _
            " " & Target, vbCritical, "VERIFICAR CÓDIGO"
            Target.Select
            Target.ClearContents
        End If
        l2.Close False
    End If
    If Target.Column = 2 Then
        valor = Target.Value
        contarsi = Application.WorksheetFunction.CountIf(Columns(2), valor)
        If contarsi > 1 Then
            MsgBox "dato duplicado, se eliminará"
            Target.Select
            Target.ClearContents
            Target.Offset(0, 1).ClearContents
        End If
    End If
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas