Problema ejecutar vlookup al agregar nuevo dato a una columna

La idea es que cuando agregas un nuevo numero en la columna "E" busque automáticamente los datos correspondientes de ese numero de la hoja "INVENTARIO" y los muestre en las columnas "C" y "D", así mismo la fecha del día de ese nuevo registro en la columna "F".
No se si me explique bien, no se mucho de programación y lo único que me aparece correctamente es la columna de la fecha.
Otra cosa, no se si deba poner cdbl pues el numero de buscar es de trece dígitos y no se si se desborde.
Les dejo el código:

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Application.Intersect(Target, Range("E:E")) Is Nothing Then
Range("F" & Target.Row) = Date
Dim noCon As Double
Dim Nombre As Double
noCon = Application.WorksheetsFunction.VLookup(Range("E:E"), INVENTARIO.Range("A:C"), 2, 0)
Range("C" & Target.Row) = noCon
Nombre = Application.WorksheetsFunction.VLookup(Range("E:E"), INVENTARIO.Range("A:C"), 3, 0)
Range("C" & Target.Row) = Nombre
End If
End Sub

2 respuestas

Respuesta
1

Prueba con la siguiente actualización

Private Sub Worksheet_Change(ByVal Target As Range)
'Act Por Dante Amor
    If Not Application.Intersect(Target, Range("E:E")) Is Nothing Then
        If Target.Value = "" Then Exit Sub
        If Target.Count > 1 Then Exit Sub
        '
        Range("F" & Target.Row) = Date
        Set h = Sheets("INVENTARIO")
        Set b = h.Columns("A").Find(Target.Value, lookat:=xlWhole)
        If Not b Is Nothing Then
            Cells(Target.Row, "C").Value = h.Cells(b.Row, "B")  'noCon
            Cells(Target.Row, "D").Value = h.Cells(b.Row, "C")  'Nombre
        End If
    End If
End Sub

'.[Sal u dos. Dante Amor. No olvides valorar la respuesta. 
'.[Avísame cualquier duda

¡Gracias!

Eres un dios!
Funciona perfectamente
Solo tuve un pequeño problema con la línea

 If Target.Value = "" Then Exit Sub

al borrar marca error pero no es nada grave.
Muchísimas gracias.

Eso puede pasar por que la celda está combinada o borras varias celdas, solamente pon estas líneas al revés:

        If Target.Count > 1 Then Exit Sub
        If Target.Value = "" Then Exit Sub

['sal u dos

Respuesta
1

Hay una forma más sencilla, convierte tu base de datos en un formato de tabla, escribe la fórmula Buscar o BuscarV y al momento de seleccionar la matriz, selecciona todo los datos excepto el encabezado, o en matriz pon el nombre de la tabla, por ejemplo:

=BUSCARV(A2, Tabla1, 2,0)

Así al agregar un dato en la ultima celda vacía, automáticamente el formato de la tabla se actualizara y en la fórmula te darán los resultados de los nuevos registros.

Gracias, lo que quiero es evitar poner las fórmulas pues si hago una modificación, también se modificaría el resultado y estar copiando y pegando como valores es bastante molesto, otra cosa es que también comparto el documento con alguien más y puede borrar la formula por consiguiente no se haría el registro correcto, por eso me animé con la macro.

Dentro de un formato de tabla no habría problemas para registrar datos mediante macros, ya que las fórmulas se auto acompletan dentro del rango de la columna donde tienes tu fórmula, simplemente al programar, solo programa los rangos que no tienen fórmula.

Para que no tengas problemas en este caso usa este código para registrar en la ultima celda vacía.

Agrega este código a un modulo.

Public Function GetUltimoR(Hoja As Worksheet) As Integer
    GetUltimoR = GetNuevoR(Hoja) - 1
End Function
Public Function GetNuevoR(Hoja As Worksheet) As Integer
    Dim Fila As Long
    Fila = 2
    Do While Hoja.Cells(Fila, 1) <> ""
        Fila = Fila + 1
    Loop
    GetNuevoR = Fila
End Function

Ahora este código lo pones en el botón del userform, solo es un ejemplo.

Private Sub CommandButton1_Click()
    Dim Fila As Long
    Dim Final As Long
'Determina el final del listado
        Final = GetNuevoR(Hoja1)
Hoja1.Cells(Final, 1) = Me.TextBox1.Text
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas