Error en listbox1 por problema de filtracion
Este codigo me lo diste recientemente, el punto es que si lo probe y funciona correcto en tu formulario
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
'Por.Dante Amor
fila = Me.ListBox1.ListIndex
cantidad = InputBox("Si estás seguro, captura la cantidad:", "Seleccionaste: " & ListBox1.List(fila, 0))
If cantidad = 0 Or cantidad = "" Then Exit Sub
'agregar el producto al pedido
FormPedido.ListBox1.AddItem Me.ListBox1.List(Me.ListBox1.ListIndex, 0) ' Producto
FormPedido.ListBox1.List(FormPedido.ListBox1.ListCount - 1, 1) = cantidad ' cantidad
FormPedido.ListBox1.List(FormPedido.ListBox1.ListCount - 1, 2) = ListBox1.List(fila, 2) ' precio
FormPedido.ListBox1.List(FormPedido.ListBox1.ListCount - 1, 3) = ListBox1.List(fila, 2) * cantidad ' importe
Unload Me
End Subel problema que tengo es el sig:
al utilizar el filtro del textbox1 se filtra la listbox1 y este me sale error
Private Sub TextBox1_Change()
On Error Resume Next
Set b = Sheets("productos")
uf = b.Range("B" & Rows.Count).End(xlUp).Row
If Trim(TextBox1.Value) = "" Then
'AQUI YO PUESE ESTO
Set b = Sheets("productos")
uf = b.Range("B" & Rows.Count).End(xlUp).Row
uc = b.Cells(3, Columns.Count).End(xlToLeft).Address
wc = Mid(uc, InStr(uc, "$") + 1, InStr(2, uc, "$") - 2)
With Me.ListBox1
.ColumnCount = 2
.ColumnWidths = "300 pt;110 pt"
.RowSource = "B3:" & wc & uf
End With
'AQUI TERMINE
Exit Sub
End If
b.AutoFilterMode = False
Me.ListBox1 = Clear
Me.ListBox1.RowSource = Clear
'''''''''''''''''''''''''''
For i = 3 To uf
strg = b.Cells(i, 2).Value
If UCase(strg) Like "*" & UCase(TextBox1.Value) & "*" Then
Me.ListBox1.AddItem b.Cells(i, 2)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = b.Cells(i, 3)
'Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = b.Cells(i, 3)
End If
Next i
Me.ListBox1.ColumnWidths = "300 pt;110 pt;"
End Subeste es el codigo que tengo que al poner algo en textbox1 si funciona el codigo pero deja de funcionar el primero
1 Respuesta
Respuesta de Dante Amor
1
No puedes utilizar additem y rowsource al mismo tiempo.
En este caso como vas a filtrar y a cargar con additem.
Entonces hay que cargar con additem desde el inicio:
Private Sub UserForm_Initialize()
Application.DisplayAlerts = False
Set b = Sheets("productos")
uf = b.Range("B" & Rows.Count).End(xlUp).Row
Me.ListBox1.ColumnWidths = "300 pt;110 pt;"
Me.ListBox1.ColumnCount = 2
For i = 3 To uf
If b.Cells(i, 2).Value <> "" Then
Me.ListBox1.AddItem b.Cells(i, 2)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = b.Cells(i, 3)
End If
Next i
End SubY para el filtro del textbox:
Private Sub TextBox1_Change()
Set b = Sheets("productos")
uf = b.Range("B" & Rows.Count).End(xlUp).Row
If Trim(TextBox1.Value) = "" Then Exit Sub
If b.AutoFilterMode Then b.AutoFilterMode = False
Me.ListBox1.Clear
'
For i = 3 To uf
strg = b.Cells(i, 2).Value
If UCase(strg) Like "*" & UCase(TextBox1.Value) & "*" Then
Me.ListBox1.AddItem b.Cells(i, 2)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = b.Cells(i, 3)
End If
Next i
End Subsal u dos
