ActiveX Combobox Blatt filtern

[Flyto]

Liebes Clever-Excel-Forum, 

Ich habe auf Blatt 1 eine ActiveX ComboBox die mir eine Range aus Blatt 3 ausgibt. Nun möchte ich, dass Blatt 2 Spalte A:AC in Spalte A nach dem Wert aus der Combobox gefiltert wird und anschließend mit den Werten aus Spalte A des Blatt 2 eine ActiveX List-Box auf Blatt 4 befüllt wird. 

Das mit dem Befüllen der Combobox, filtern des Blattes 2 und befüllen der ListBox klappt soweit, allerdings wird 1. auf Blatt 2 der Filter nur auf Spalte 2 platziert sodass ich die weiteren Spalten nicht mehr manuell filtern kann, und 2. jedes mal wenn ich in der ListBox einen anderen Wert anklicke wird der ganze Filter-Prozess neu durchgeführt - das kann ich nicht nachvollziehen...

Das ist mein Aktueller Code:

Code:

Public Sub KAMSelect_Change()
Dim ws As Worksheet
Dim Dashboard As Worksheet
Set ws = Sheets("Datenbasis")
Set Dashboard = Sheets("Dashboard")
Dim lrow As Long
Dim i As Long, j As Long


If KAMSelect.ListIndex = -1 Then Exit Sub
   
    '~~> Clear the listbox
    Sheets("Dashboard").KAMParts.Clear
   
    Dim DataRange As Range, rngArea As Range
    Dim DataSet As Variant
   
    With ws
        '~~> Remove any filters
        .AutoFilterMode = False
       
        '~~> Find last row in Col C
        lrow = .Range("B" & .Rows.Count).End(xlUp).Row
       
        '~~> Filter on the relevant column
        With .Range("A4:A" & lrow)
            .AutoFilter Field:=1, Criteria1:=Sheets("Introduction").KAMSelect.Text
           
            On Error Resume Next
            Set DataRange = .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow
            On Error GoTo 0
        End With
       
        '~~> Check if the autofilter returned any results
        If Not DataRange Is Nothing Then
            '~~> Instead of using another object, I am reusing the object
            Set DataRange = .Range("B2:B" & lrow).SpecialCells(xlCellTypeVisible)
           
            '~~> Create the array
            ReDim DataSet(1 To DataRange.Areas.Count + 1, 1 To 8)
           
            j = 1
           
            '~~> Loop through the area and store in the array
            For Each rngArea In DataRange.Areas
                For i = 1 To 8
                    DataSet(j, i) = rngArea.Cells(, i).Value2
                Next i
                j = j + 1
            Next rngArea
           
            '~~> Set the listbox list
            Sheets("Dashboard").KAMParts.List = DataSet
        End If
       
        '~~> Remove any filters
        .AutoFilterMode = False
    End With


End Sub

Folgende Zeile führt aber immer wieder mal zu einer Fehlermeldung:

Code:

.AutoFilter Field:=1, Criteria1:=Sheets("Introduction").KAMSelect.Text

"autofilter method of range class failed"

Freue mich über jede Hilfe!

[Klaus-Dieter]

Hallo,

du weißt schon, das hier nicht das Herber-Forum ist?

[Flyto]

#bodenversink

Bin normalerweise hier, aber bin auch sehr überarbeitet und übermüdet und war irgendwie erst auf Herbers, habs dort aber nicht gepostet gekriegt...echt peinlich tut mir leid

[Klaus-Dieter]

Hallo,

dann lade doch bitte eine Beispieldatei hoch. Nur anhand des Quelltextes wird das schwierig, Lösungsvorschläge zu erstellen.

[snb]

Auch zu überarbeitet um eine Beispieldatei hochzuladen ?

4 Arbeitsblätter scheinen mir schon 2 zuviel.

[Flyto]

Ok Leute, tut mir sehr leid, dass ich euch so die Zeit stehle, das war ein Griff ins Klo.
Habe gerade eine Beispieldatei erstellt (da hab ich natürlich auch nicht dran gedacht) und dabei den Fehler erkannt (sitz jetzt aber schon 2h dran und bin dran verzweifelt). Fehler war aber ganz einfach, dass sich die Range aus Blatt 3 automatisch aus Blatt 2 berechnet, das hatte ich nicht mehr am Schirm und dadurch gabs nen Zirkel....selten sowas doofes mal wieder.

Habt mir damit also trotzdem sehr geholfen!! Echt schon wieder zu viel so kurz vor Weihnachten...

4 Arbeitsblätter scheinen mir schon 2 zuviel.

Eines ist die Startseite inkl. Nutzerauswahl, Blatt 2 ist die Datenbank, Blatt 3 ist das Settings-Panel und Blatt 4 ist das Dashboard. 

Wünsch euch beiden ganz schöne Feiertage und nen guten Rutsch!