Problemas con un código en EXCEL VBA
Tengo un problema con un código en excel vba, tengo un formulario en cual quiero que con el cambio de unas de sus textbox realice un vlookup y busque los datos de los demás labels que tengo en el formulario, (Esa parte lo tengo hecha), después quiero que tome esos valores y los guarde en una hoja de excel con un orden descendente (Esa parte la tengo hecha), ahora tengo un ErrorHandler para el error 13, (es decir el error que sale cuando el valor que se esta buscando en el vlookup no aparece en la base de datos) que sale un MsgBox de error. Seguido de un empty en textbook con el vlookup.
Para no hacer larga la historia cada vez que hago en empty en el textbook me hace un change y bueno ya sabrán que pasa, la lógica del código no corre como espero.
Mi objetivo con el código es el siguiente
Que con ese textbox yo pueda con un lector leer un código y se refleje en el textbox, luego que busque los valores, que los copie en el hoja de excel y que después el textbox este vacío para poder leer otro código con el lector ahí mismo. Sin tener que darle a ningún botón ni nada.
Este es el código que tengo
Private Sub TrackingLabel_Change()
On Error GoTo ErrorHandler
blog = Error
Set AccListSH = Sheets("Insert_Sheet")
ValorABuscar = TrackingLabel.Value
MensajeroLabel.Caption = Application.VLookup(ValorABuscar, AccListSH.Range("A:H"), 2, False)
ClienteLabel.Caption = Application.VLookup(ValorABuscar, AccListSH.Range("A:H"), 5, False)
ProductoLabel.Caption = Application.VLookup(ValorABuscar, AccListSH.Range("A:H"), 3, False)
TCLabel.Caption = Application.VLookup(ValorABuscar, AccListSH.Range("A:H"), 4, False)
CedulaLabel.Caption = Application.VLookup(ValorABuscar, AccListSH.Range("A:H"), 6, False)
ErrorHandler:
If Err.Number = 13 Then
TrackingLabel = Empty
MsgBox "Tracking no encontrado", vbExclamation, blog
End If
Dim fila As Long
fila = 1
While Cells(fila, 1) <> ""
fila = fila + 1
Wend
Cells(fila, 1) = 1
Cells(fila, 2) = FechaLabel.Caption
Cells(fila, 3) = USERONLINE.Caption
Cells(fila, 4) = MensajeroLabel.Caption
Cells(fila, 5) = ClienteLabel.Caption
Cells(fila, 6) = TCLabel.Caption
Cells(fila, 7) = CedulaLabel.Caption
Cells(fila, 8) = EstatusLabel.Value
TrackingLabel = Empty
End Sub
1 Respuesta
La manera simple de solucionarlo es así:
Después de esta línea:
ValorABuscar = TrackingLabel.Value
Pon esta línea:
If ValorABuscar = "" then exit sub
Pero lo ideal es que sigas las siguientes recomendaciones:
1. En la medida de lo posible evitar el uso de "On Error Goto", ya que pueden ocurrir varios errores y no sabrás cuál es el problema, por lo que deberás, mediante código tratar de evita cualquier error que pudiera ocurrir.
2. Cambia Vlookup por el método Find
3. Nombra como textbox a los textbox y a los label como labels, para que no te confundas, estos TrackingLabel y EstatusLabel, supongo que son textbox, entonces no le pongas Label, pon TrackcingText y EstatusText o algo así.
4. En las columnas utiliza las letras, de esa forma es más claro ver a qué columna te refieres.
Te anexo el código actualizado, cambia "Hoja2" por el nombre de la hoja que vas a actualizar.
Private Sub TrackingLabel_Change()
'Act.Por.Dante Amor
Set h1 = Sheets("Insert_Sheet")
Set h2 = Sheets("Hoja2") 'hoja donde se copian los datos
valor = TrackingLabel.Value
If valor = "" Then Exit Sub
'
Set b = h1.Columns("A").Find(valor, lookat:=xlWhole)
If Not b Is Nothing Then
MensajeroLabel.Caption = h1.Cells(b.Row, "B")
ClienteLabel.Caption = h1.Cells(b.Row, "E")
ProductoLabel.Caption = h1.Cells(b.Row, "C")
TCLabel.Caption = h1.Cells(b.Row, "D")
CedulaLabel.Caption = h1.Cells(b.Row, "F")
'
fila = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
h2.Cells(fila, "A") = 1
h2.Cells(fila, "B") = FechaLabel.Caption
h2.Cells(fila, "C") = USERONLINE.Caption
h2.Cells(fila, "D") = MensajeroLabel.Caption
h2.Cells(fila, "E") = ClienteLabel.Caption
h2.Cells(fila, "F") = TCLabel.Caption
h2.Cells(fila, "G") = CedulaLabel.Caption
h2.Cells(fila, "H") = EstatusLabel.Value
Else
MsgBox "Tracking no encontrado", vbExclamation, blog
End If
TrackingLabel = Empty
End Sub.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.
¡Gracias! Funciono perfectamente, los labels que tengo en verdad son labels no son text box pero igual muchisimas gracias amigo
Una pregunta, en esta línea lo que en verdad quiero agregar es un serie de numero dependiendo del registro, si estoy agregando el primer registro que indique el numero 1, si voy por el tercer registro que tenga el 3 y así, una secuencia.
h2.Cells(fila, "A") = 1
Podría ser así:
Private Sub TrackingLabel_Change()
'Act.Por.Dante Amor
Set h1 = Sheets("Insert_Sheet")
Set h2 = Sheets("Hoja2") 'hoja donde se copian los datos
valor = TrackingLabel.Value
If valor = "" Then Exit Sub
'
Set b = h1.Columns("A").Find(valor, lookat:=xlWhole)
If Not b Is Nothing Then
MensajeroLabel.Caption = h1.Cells(b.Row, "B")
ClienteLabel.Caption = h1.Cells(b.Row, "E")
ProductoLabel.Caption = h1.Cells(b.Row, "C")
TCLabel.Caption = h1.Cells(b.Row, "D")
CedulaLabel.Caption = h1.Cells(b.Row, "F")
'
fila = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
serie = WorksheetFunction.Max(h2.Range("A2:A" & fila - 1)) + 1
h2.Cells(fila, "A") = serie
h2.Cells(fila, "B") = FechaLabel.Caption
h2.Cells(fila, "C") = USERONLINE.Caption
h2.Cells(fila, "D") = MensajeroLabel.Caption
h2.Cells(fila, "E") = ClienteLabel.Caption
h2.Cells(fila, "F") = TCLabel.Caption
h2.Cells(fila, "G") = CedulaLabel.Caption
h2.Cells(fila, "H") = EstatusLabel.Value
Else
MsgBox "Tracking no encontrado", vbExclamation, blog
End If
TrackingLabel = Empty
End Subsal u dos
