Errores en tiempo de ejecución excel macros Espero que me puedan ayudar. De verdad se los agradecería mucho.
Tengo un sistema en excel macros al que me pidieron hacerle algunos algunos ajustes ya que un alguien lo entrego para la empresa donde trabajo sin funcionar del todo bien. El problema es que uno de los módulos muestra 2 errores, uno es el error 13 y el otro es un error 1004, ambos de tiempo de ejecución y la verdad es que, aunque me asignaron a mi el arreglo del sistema, mi especialidad no es visualbasic, así que estoy extremadamente perdido y no se como solucionar dichos errores.
Esta parte del sistema consiste en 3 combobox que filtran información en una base de datos que esta en una hoja de excel y de acuerdo a las opciones que se seleccionen en los combobox, se va cargando la información en un Listbox. El error 13 en tiempo de ejecución se presenta cuando selecciono en el combobox2 alguna opción que devuelve 1 o 0 registros pero no encuentro que debo modificar para solucionarlo y el error 1004 en tiempo de ejecución aparece al seleccionar algunas de las opciones del combobox2 y del combobox3, pero en realidad desconozco cual es el motivo por el que aparece.
A continuación agrego el código:
Código:
En el siguiente link, he publicado una captura de pantalla de la hoja de calculo en la que esta almacenada la información.Option Explicit
Dim FArray As Variant
Dim DataList As Range, cel As Range, Rng As Range
Dim MyList As String
Dim ws As Worksheet
Dim v, e
Private Sub UserForm_Initialize()
Dim Found As Long, i As Long
Sheets("INVENTORY").Select
Sheets("INVENTORY").AutoFilterMode = False
MyList = "INVDATA"
Set DataList = Range(MyList).Columns(1)
DataList.Select
Set DataList = Selection
ReDim FArray(DataList.Cells.Count)
i = -1
For Each cel In DataList
On Error Resume Next
Found = Application.WorksheetFunction.Match(cel, FArray, 0)
If Found > 0 Then GoTo Exists
i = i + 1
FArray(i) = cel
Exists:
Found = 0
Next
ReDim Preserve FArray(i)
Call BubbleSort(FArray)
ComboBox1.ListRows = i + 1
ComboBox1.List() = FArray
End Sub
Private Sub ComboBox1_Change()
With Me.ListBox1
.RowSource = ""
End With
Flag = True
ComboBox2.Clear
ComboBox3.Clear
ComboBox4.Clear
Set ws = Sheets("INVENTORY")
With ws
If Not ActiveSheet.AutoFilterMode Then
ActiveSheet.Range("A1").AutoFilter
End If
.Range(("A1"), .Range("A1").End(xlDown)).AutoFilter Field:=2
.Range(("A1"), .Range("A1").End(xlDown)).AutoFilter Field:=3
.Range(("A1"), .Range("A1").End(xlDown)).AutoFilter Field:=4
.Range(("A1"), .Range("A1").End(xlDown)).AutoFilter Field:=1, Criteria1:=Me.ComboBox1.Value
Set Rng = .Range("INVDATA").Columns(1).SpecialCells(xlCellTypeVisible)
For Each cel In Rng
With Me.ListBox1
.AddItem cel.Value
.List(.ListCount - 1, 1) = cel.Offset(0, 1).Value
.List(.ListCount - 1, 2) = cel.Offset(0, 2).Value
.List(.ListCount - 1, 3) = cel.Offset(0, 3).Value
.List(.ListCount - 1, 4) = cel.Offset(0, 4).Value
.List(.ListCount - 1, 5) = cel.Offset(0, 5).Value
.List(.ListCount - 1, 6) = cel.Offset(0, 6).Value
.List(.ListCount - 1, 7) = cel.Offset(0, 7).Value
.List(.ListCount - 1, = cel.Offset(0, 8).Value
.List(.ListCount - 1, 9) = cel.Offset(0, 9).Value
End With
Next cel
Set Rng = .Range("INVDATA").Columns(2).SpecialCells(xlCellTypeVisible)
For Each cel In Rng
With Me.ComboBox2
.AddItem cel.Offset(0, 0).Value
End With
Next cel
End With
Flag = False
With Sheets("INVENTORY").Range("B3", Sheets("INVENTORY").Range("B65536").End(xlUp)).SpecialCells(xlCellTypeVisible)
v = .Value
End With
With CreateObject("scripting.dictionary")
.comparemode = 1
For Each e In v
If Not .Exists(e) Then .Add e, Nothing
Next
If .Count Then Me.ComboBox2.List = Application.Transpose(.keys)
End With
End Sub
Private Sub ComboBox2_Click()
If Flag = True Then Exit Sub
ComboBox3.Clear
ComboBox4.Clear
Me.ListBox1.Clear
Set ws = Sheets("INVENTORY")
With ws
.Range(("A1"), .Range("A1").End(xlDown)).AutoFilter Field:=3
.Range(("A1"), .Range("A1").End(xlDown)).AutoFilter Field:=4
.Range(("A1"), .Range("A1").End(xlDown)).AutoFilter Field:=2, Criteria1:=Me.ComboBox2.Value
Set Rng = .Range("INVDATA").Columns(1).SpecialCells(xlCellTypeVisible)
For Each cel In Rng
With Me.ListBox1
.AddItem cel.Value
.List(.ListCount - 1, 1) = cel.Offset(0, 1).Value
.List(.ListCount - 1, 2) = cel.Offset(0, 2).Value
.List(.ListCount - 1, 3) = cel.Offset(0, 3).Value
.List(.ListCount - 1, 4) = cel.Offset(0, 4).Value
.List(.ListCount - 1, 5) = cel.Offset(0, 5).Value
.List(.ListCount - 1, 6) = cel.Offset(0, 6).Value
.List(.ListCount - 1, 7) = cel.Offset(0, 7).Value
.List(.ListCount - 1, = cel.Offset(0, 8).Value
.List(.ListCount - 1, 9) = cel.Offset(0, 9).Value
End With
Next cel
Set Rng = .Range("INVDATA").Columns(3).SpecialCells(xlCellTypeVisible)
For Each cel In Rng
With Me.ComboBox3
.AddItem cel.Offset(0, 0).Value
End With
Next cel
End With
With Sheets("INVENTORY").Range("C3", Sheets("INVENTORY").Range("C65536").End(xlUp)).SpecialCells(xlCellTypeVisible)
v = .Value
End With
With CreateObject("scripting.dictionary")
.comparemode = 1
For Each e In v
If Not .Exists(e) Then .Add e, Nothing
Next
If .Count Then Me.ComboBox3.List = Application.Transpose(.keys)
End With
End Sub
Private Sub ComboBox3_Click()
If Flag = True Then Exit Sub
ComboBox4.Clear
Me.ListBox1.Clear
Set ws = Sheets("INVENTORY")
With ws
.Range(("A1"), .Range("A1").End(xlDown)).AutoFilter Field:=4
.Range(("A1"), .Range("A1").End(xlDown)).AutoFilter Field:=3, Criteria1:=Me.ComboBox3.Value
Set Rng = .Range("INVDATA").Columns(1).SpecialCells(xlCellTypeVisible)
For Each cel In Rng
With Me.ListBox1
.AddItem cel.Value
.List(.ListCount - 1, 1) = cel.Offset(0, 1).Value
.List(.ListCount - 1, 2) = cel.Offset(0, 2).Value
.List(.ListCount - 1, 3) = cel.Offset(0, 3).Value
.List(.ListCount - 1, 4) = cel.Offset(0, 4).Value
.List(.ListCount - 1, 5) = cel.Offset(0, 5).Value
.List(.ListCount - 1, 6) = cel.Offset(0, 6).Value
.List(.ListCount - 1, 7) = cel.Offset(0, 7).Value
.List(.ListCount - 1, = cel.Offset(0, 8).Value
.List(.ListCount - 1, 9) = cel.Offset(0, 9).Value
End With
Next cel
Set Rng = .Range("INVDATA").Columns(4).SpecialCells(xlCellTypeVisible)
For Each cel In Rng
With Me.ComboBox4
.AddItem cel.Offset(0, 0).Value
End With
Next cel
End With
End Sub
Sub BubbleSort(MyArray As Variant)
Dim First As Integer
Dim Last As Integer
Dim i As Integer
Dim j As Integer
Dim Temp As String
First = LBound(MyArray)
Last = UBound(MyArray)
For i = First To Last - 1
For j = i + 1 To Last
If MyArray(i) > MyArray(j) Then
Temp = MyArray(j)
MyArray(j) = MyArray(i)
MyArray(i) = Temp
End If
Next j
Next i
End Sub
[URL="http://www.customapps4business.com/muestra.jpg"]http://www.customapps4business.com/muestra.jpg[/URL]
El "INVDATA" que aparece en el código, se refiere a la siguiente formula:
=DESREF(INVENTORY!$A$3;0;0;(CONTARA(INVENTORY!$A:$ A)-2);10)
De verdad les agradecería su ayuda.
