Necesito una macro para Buscar un valor y al hallarlo pegue datos en las tres columnas siguientes
Necesito una macro para Buscar un valor (Buscar en columna A) y al hallarlo, pegue datos en las celdas del costado de las tres columnas siguientes (Columna B, C y D). Me explico, tengo un formulario (ya realizado) con cuatro TextBox y un CommandButton. TextBox1 (N° Pedido), TextBox2 (GR Madre), TextBox3 (GR Hija), TextBox4 (Peso) y CommandButton1 (Ingresar datos). La idea es que al presionar "Ingresar datos" se pongan los datos en la columna que le corresponda de acuerdo al "N° Pedido" hallado (TextBox1). Adjunto código fuente de lo que ya he desarrollado y hasta ahí va todo bien.
Agradezco de antemano por su apoyo. Saludos cordiales.
Sub Borrar_BD()
Cells.Select
Selection.ClearContents
Range("A1").Select
End Sub
Sub Maximo()
'Elimina primera fila
Rows("1:1").Select
Selection.Delete Shift:=xlUp
'Separa todas las celdas combinadas
Range("A1:AZ50000").UnMerge
'Elimina la ultima fila (Contiene fecha y datos que distorsionan BD)
Dim FilaEliminar As Long
FilaEliminar = ActiveSheet.Cells(65536, 1).End(xlUp).Row
ActiveSheet.Cells(FilaEliminar, 1).EntireRow.Delete Shift:=xlUp
'Elimina columnas en blanco
Columns("Z:Z").Select
Selection.Delete Shift:=xlToLeft
Columns("AS:AS").Select
Selection.Delete Shift:=xlToLeft
Columns("AT:AT").Select
Selection.Delete Shift:=xlToLeft
'Inserta columnas
Columns("B:B").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B1").Select
ActiveCell.FormulaR1C1 = "GR Madre"
Range("C1").Select
ActiveCell.FormulaR1C1 = "GR Hija"
Range("D1").Select
ActiveCell.FormulaR1C1 = "PESO"
'Ordena tamaño de columnas
Cells.Select
Cells.EntireColumn.AutoFit
'Cursor en celda de inicio
Range("A1").Select
'Aparecer formulario
UserForm.Show
End Sub
2 Respuestas
Te anexo el código para el botón de tu form, para ingresar los datos:
Private Sub CommandButton1_Click()
'Por Dante Amor
'Ingresar datos
pedido = TextBox1.Value
If pedido = "" Then
MsgBox "Debes capturar un número de pedido"
TextBox1.SetFocus
Exit Sub
End If
If IsNumeric(pedido) Then pedido = Val(pedido)
Set h = Sheets("Report")
Set b = h.Columns("A").Find(pedido, lookat:=xlWhole)
If Not b Is Nothing Then
h.Cells(b.Row, "B") = TextBox2.Value
h.Cells(b.Row, "C") = TextBox3.Value
h.Cells(b.Row, "D") = TextBox4.Value
MsgBox "Datos ingresados"
Else
MsgBox "El pedido no existe"
TextBox1.SetFocus
End If
End Sub.
.
¡Gracias! Funcionó a la perfección.
Sin embargo solo ingresa los datos en la primera fila que encuentra y no en la consecutiva que también tiene el mismo numero de pedido. favor tu enseñanza con ello.
Finalmente, como hago para borrar los TextBox después de haber ingresados los Datos.
En tu imagen los número de pedido se ven únicos, quieres decir que vas a tener varias filas con el mismo número de pedido, si es así, entonces utiliza los siguiente:
Private Sub CommandButton1_Click()
'Por Dante Amor
'Ingresar datos
pedido = TextBox1.Value
If pedido = "" Then
MsgBox "Debes capturar un número de pedido"
TextBox1.SetFocus
Exit Sub
End If
If IsNumeric(pedido) Then pedido = Val(pedido)
Set h = Sheets("Report")
Set r = h.Columns("A")
Set b = r.Find(pedido, LookAt:=xlWhole)
If Not b Is Nothing Then
celda = b.Address
Do
'detalle
h.Cells(b.Row, "B") = TextBox2.Value
h.Cells(b.Row, "C") = TextBox3.Value
h.Cells(b.Row, "D") = TextBox4.Value
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> celda
MsgBox "Datos ingresados"
TextBox1.Value = ""
TextBox2.Value = ""
TextBox3.Value = ""
TextBox4.Value = ""
TextBox1.SetFocus
Else
MsgBox "El pedido no existe"
TextBox1.SetFocus
End If
End Subsal u dos
Prueba esta macro, conforme tecleas los datos en los textbox se van capturando
Private Sub TextBox1_AfterUpdate()
Set DATOS = Range("A1").CurrentRegion
With DATOS
PEDIDO = Val(TextBox1.Text)
FILAS = .Rows.Count: COL = .Columns.Count
Set DATOS = .Resize(FILAS, 4)
FILA = WorksheetFunction.Match(PEDIDO, .Columns(1), 0)
Set PDATOS = DATOS.Rows(FILA)
With PDATOS
.Select
.Name = "REGISTRO"
End With
End With
End Sub
Private Sub TextBox2_AfterUpdate()
Range("REGISTRO")(2) = TextBox2.Text
End Sub
Private Sub TextBox3_AfterUpdate()
Range("REGISTRO")(3) = TextBox3.Text
End Sub
Private Sub TextBox4_AfterUpdate()
Range("REGISTRO")(4) = TextBox4.Text
End Sub