Buenas noches de nuevo!!

Tengo un formulario donde quiero filtrar unos datos y que los traiga a un listbox pero cuando ejecuto la búsqueda me da el error siguiente: "Se ha producido el error 381 en tiempo de ejecución: Could not set the list property. Invalid property array index"

Describo el código que tengo por si me podéis ayudar a dar con el problema (lo tengo hecho en otra base de datos y me funciona perfectamente..... no entiendo porque en esta no...)

Private Sub cmbEncabezado_Change()
Me.lblFiltro = "Filtro por " & Me.cmbEncabezado.Value
End Sub

'Mostrar resultado en ListBox
Private Sub CommandButton5_Click()
    Set h1 = Sheets("ENTIDADES")
    Set h2 = Sheets("Temporal")
    If Me.txtFiltro1.Value = "" Then
        MsgBox "Debe introducir un criterio y un valor de búsqueda"
        Exit Sub
    If cmbEncabezado = "" Then
        Exit Sub
    End If
    End If
    
    h2.Cells.Clear
    ListBox1.RowSource = ""
    h1.Rows(1).Copy h2.Rows(1)
    j = cmbEncabezado.ListIndex + 1
    n = 2
    
    For i = 2 To Range("a1").CurrentRegion.Rows.Count
        If LCase(Cells(i, j)) Like "*" & LCase(txtFiltro1) & "*" Then
            h1.Rows(i).Copy h2.Rows(n)
            n = n + 1
        End If
    Next i
    u = Range("A" & Rows.Count).End(xlUp).Row
    If u = 1 Then
        MsgBox "No existen registros con ese filtro", vbExclamation, "FILTRO"
        Exit Sub
    End If

    ListBox1.RowSource = h2.Name & "!A2:T" & u
End Sub

'Dar formato al ListBox y traer los encabezados de la tabla
Private Sub UserForm_Initialize()
'
For i = 1 To 20
        'Me.Controls("Label" & i) = Cells(1, i).Value
    Next i
    
    [A1].Select
    With Me
        .ListBox1.ColumnHeads = True
        .ListBox1.ColumnCount = 20
        .ListBox1.ColumnWidths = "100 pt;55 pt;80 pt;75 pt;220 pt;50 pt;75 pt;75 pt;80 pt;200 pt;80 pt;90 pt; 80 pt; 75 pt; 80 pt; 70 pt; 60 pt; 60 pt; 60 pt; 60 pt"
        
        .cmbEncabezado.List = Application.Transpose(ActiveCell.CurrentRegion.Resize(1).Value)
        .cmbEncabezado.ListStyle = fmListStyleOption
    End With
End Sub

'Cerrar formulario
Private Sub CommandButton2_Click()
Unload Me
End Sub

'Limpiar el Listbox

Private Sub CommandButton4_Click()
Me.ListBox1.RowSource = ""
End Sub

Muchas gracias por vuestra ayuda!!

 

 

Editado el el 21 de noviembre6 años por SUSANA GARCIA-ABAD FERNANDEZ
Se me olvidó añadir una cosa

Hola

Sugiero que envíes el archivo para poder reproducir tu problema y ayudarte.

Saludos

Abraham Valencia

Hace 18 horas, avalencia dijo:

Hola

Sugiero que envíes el archivo para poder reproducir tu problema y ayudarte.

Saludos

Abraham Valencia

Ok 

Pongo enlace del archivo

https://drive.google.com/open?id=16z8xYmpL4wC7n4K3vPS9MYl-qbIh3LCH

Gracias!!

Sustituye el procedimiento:

'Dar formato al ListBox y traer los encabezados de la tabla
Private Sub UserForm_Initialize()
'
For i = 1 To 20
   'Me.Controls("Label" & i) = Cells(1, i).Value
Next i
    
With ListBox1
    .ColumnHeads = True
    .ColumnCount = 20
    .ColumnWidths = "250;55;80;75;220;50;75;75;80;200;80;90;80;75;80;70;60;60;60;60"
    cmbEncabezado.List = Application.Transpose(Sheets("Entidades").Range("A1").CurrentRegion.Resize(1).Value)
    cmbEncabezado.ListStyle = fmListStyleOption
End With
End Sub

 

En ‎22‎/‎11‎/‎2018 at 18:05 , Antoni dijo:

Sustituye el procedimiento:

'Dar formato al ListBox y traer los encabezados de la tabla
Private Sub UserForm_Initialize()
'
For i = 1 To 20
   'Me.Controls("Label" & i) = Cells(1, i).Value
Next i
    
With ListBox1
    .ColumnHeads = True
    .ColumnCount = 20
    .ColumnWidths = "250;55;80;75;220;50;75;75;80;200;80;90;80;75;80;70;60;60;60;60"
    cmbEncabezado.List = Application.Transpose(Sheets("Entidades").Range("A1").CurrentRegion.Resize(1).Value)
    cmbEncabezado.ListStyle = fmListStyleOption
End With
End Sub

 

Buenas noches Antoni!!

Lo he modificado y funciona perfectamente. Muchas gracias por tu ayuda.

 

En ‎24‎/‎11‎/‎2018 at 20:47 , SUSANA GARCIA-ABAD FERNANDEZ dijo:

Buenas noches Antoni!!

Lo he modificado y funciona perfectamente. Muchas gracias por tu ayuda.

 

 

En ‎22‎/‎11‎/‎2018 at 18:05 , Antoni dijo:

Sustituye el procedimiento:

'Dar formato al ListBox y traer los encabezados de la tabla
Private Sub UserForm_Initialize()
'
For i = 1 To 20
   'Me.Controls("Label" & i) = Cells(1, i).Value
Next i
    
With ListBox1
    .ColumnHeads = True
    .ColumnCount = 20
    .ColumnWidths = "250;55;80;75;220;50;75;75;80;200;80;90;80;75;80;70;60;60;60;60"
    cmbEncabezado.List = Application.Transpose(Sheets("Entidades").Range("A1").CurrentRegion.Resize(1).Value)
    cmbEncabezado.ListStyle = fmListStyleOption
End With
End Sub

 

Hola de nuevo Antoni

  Se me plantea una duda.... He comprobado que funciona siempre y cuanto la hoja de ENTIDADES se muestre; si permanece oculta arroja como resultado "no existen registros con ese filtro".... Hay alguna forma de introducir algún código para que muestre los datos aunque la hoja en cuestión esté oculta????

Gracias!!

 

Fácil solución, muestra la hoja al entrar en el procedimiento y ocúltala al salir. 

Pero cómo lo hago

Hace 1 hora, Antoni dijo:

Fácil solución, muestra la hoja al entrar en el procedimiento y ocúltala al salir. 

Pero cómo lo hago?? Esto es lo que tengo metido...

'Cambia el TextBox con cada cambio en el Combo
Private Sub cmbEncabezado_Change()
Me.lblFiltro = "Filtro por " & Me.cmbEncabezado.Value
End Sub

'Mostrar resultado en ListBox
Private Sub CommandButton1_Click()
    Set h1 = Sheets("ENTIDADES")
    Set H2 = Sheets("Temporal")
    If Me.txtFiltro1.Value = "" Then
        MsgBox "Debe introducir un criterio y un valor de búsqueda"
        Exit Sub
    If cmbEncabezado = "" Then
        Exit Sub
    End If
    End If
    
    H2.Cells.Clear
    ListBox1.RowSource = ""
    h1.Rows(1).Copy H2.Rows(1)
    j = cmbEncabezado.ListIndex + 1
    n = 2
    
    For i = 2 To Range("a1").CurrentRegion.Rows.Count
        If LCase(Cells(i, j)) Like "*" & LCase(txtFiltro1) & "*" Then
            h1.Rows(i).Copy H2.Rows(n)
            n = n + 1
        End If
    Next i
    u = H2.Range("A1").CurrentRegion.Rows.Count
    If u = 1 Then
        MsgBox "No existen registros con ese filtro", vbExclamation, "FILTRO"
        Exit Sub
    End If
    ListBox1.RowSource = H2.Name & "!A2:U" & u
End Sub

'Activar la celda del registro elegido
Private Sub Listbox1_Click()
Range("a2").Activate
Cuenta = Me.ListBox1.ListCount
Set rango = Range("A1").CurrentRegion
C = rango.Columns.Count
For i = 0 To Cuenta - 1
    If Me.ListBox1.Selected(i) Then
        Valor = Me.ListBox1.List(i)
        rango.Find(What:=Valor, LookAt:=xlWhole, After:=ActiveCell).Resize(1, C).Select
    End If
Next i
End Sub
'Dar formato al ListBox y traer los encabezados de la tabla
Private Sub UserForm_Initialize()

For i = 1 To 21
        'Me.Controls("Label" & i) = Cells(1, i).Value
    Next i
    
    [A1].Select
    With Me
        .ListBox1.ColumnHeads = True
        .ListBox1.ColumnCount = 21
        .ListBox1.ColumnWidths = "20 pt;250 pt;55 pt;80 pt;75 pt;220 pt;50 pt;75 pt;75 pt;80 pt;200 pt;80 pt;90 pt; 80 pt; 75 pt; 80 pt; 70 pt; 60 pt; 400 pt; 150 pt; 150 pt"
        .cmbEncabezado.List = Application.Transpose(ActiveCell.CurrentRegion.Resize(1).Value)
        .cmbEncabezado.ListStyle = fmListStyleOption
    End With

End Sub
 

Gracias!!

 

 

 

@SUSANA GARCIA-ABAD FERNANDEZ Amiga Amiga...

Por lo menos primero consulta la WEB y ya si no encuentras solución... entonces preguntas.

Y ya que estés investigando en la WEB de paso aprende a utilizar la GRABADORA DE MACROS ya que es muy útil y más cuando uno esta empezando (como YO) a lo mejor el código resultante no sea muy reducido, pero nos da la idea de como hacer las cosas.

Saludos.

Hace 18 minutos , Leopoldo Blancas dijo:

@SUSANA GARCIA-ABAD FERNANDEZ Amiga Amiga...

Por lo menos primero consulta la WEB y ya si no encuentras solución... entonces preguntas.

Y ya que estés investigando en la WEB de paso aprende a utilizar la GRABADORA DE MACROS ya que es muy útil y más cuando uno esta empezando (como YO) a lo mejor el código resultante no sea muy reducido, pero nos da la idea de como hacer las cosas.

Saludos.

Gracias Leopoldo

Lo hare