EXCEL VBA: Run-time error '13' Type missmatch: Listboxes

Gemitec · Jun 22, 2021

Hello, I have already posted this on Stackoverflow, but I better also try here

I saw a great tutorial from this gentleman: https://www.businessprogrammer.com/how-to-use-listbox-in-excel-vba-userform/ But if I only make 1 data row, I get an error: Type missmatch. Can you help me why I get this error, even if I have x Rows but the same City name, I also get this error.... strange
Its about this code part here (ex. listbox1 gives according to what is selected listbox2 listing. But if only 1 kind off datarow is found I get, error, and I tried to fix it with an "if", but then my listindex i screwed up, and I can select 1 empty row in the listbox): This is an example of a listbox

VBA Code:

Private Sub ListBox2_Change()
    Dim rngData As Range, rngCrit As Range, rngExt As Range
    Dim Ebene2kategorie() As Variant
   
    CategoryCriteria.Range("E2").ClearContents
    CategoryCriteria.Range("G2").ClearContents
    CategoryCriteria.Range("I2").ClearContents
    CategoryCriteria.Range("K2").ClearContents
    CategoryCriteria.Range("M2").ClearContents
    CategoryCriteria.Range("O2").ClearContents

    If ListBox2.ListIndex = -1 Then Exit Sub   ' nothing is selected, so quit
    Debug.Print ListBox2.List(ListBox2.ListIndex)

    CategoryCriteria.Range("c2").Value = ListBox2.List(ListBox2.ListIndex)
    Set rngData = ArtikelDatasource.Range("A1").CurrentRegion
    Set rngCrit = CategoryCriteria.Range("A1").CurrentRegion
    Set rngExt = ArticleCriteria.Range("A6").CurrentRegion.Resize(1)
    rngData.AdvancedFilter xlFilterCopy, rngCrit, rngExt
    Set rngData = rngExt.CurrentRegion
   
    If rngData.Rows.Count > 1 Then
   
    If rngExt.Rows.Count < 3 Then
   
       Set rngData = rngData.Resize(rngData.Rows.Count - 0).Offset(1)
       'ListBox2.RowSource = "'" & rngData.Parent.Name & "'!" & rngData.Address
      
       Else
       Set rngData = rngData.Resize(rngData.Rows.Count - 1).Offset(1)
       End If
      
    Else
   

        Debug.Print "Error, No data for given list item, which is kinda strange...."
        Exit Sub
    End If
    'ListBox2.Clear
    Ebene2kategorie = GetEbene2List()
    ListBox3.List = Ebene2kategorie
    ListBox3.ListIndex = -1
End Sub
Private Function GetEbene2List() As Variant
    Dim rngData As Range, rngCrit As Range, rngExt As Range
    Dim vReturn As Variant
    Dim i As Integer
   
    Set rngData = ArticleCriteria.Range("A6").CurrentRegion
    Set rngCrit = CategoryCriteria.Range("f1:f2")
    Set rngExt = CategoryCriteria.Range("f6")
    rngData.AdvancedFilter xlFilterCopy, rngCrit, rngExt, True
    Set rngExt = rngExt.CurrentRegion
   
    ' Sort the cities ascending
    rngExt.Sort Key1:=rngExt.Resize(1, 1), Header:=xlYes, Order1:=xlAscending
   
    If rngExt.Rows.Count > 1 Then
        If rngExt.Rows.Count < 3 Then
        vReturn = rngExt.Resize(rngExt.Rows.Count - 0).Offset(1)
        Else
        vReturn = rngExt.Resize(rngExt.Rows.Count - 1).Offset(1)
        End If
    Else
   
        ' Use this to return "no data" message
        vReturn = noDataArray()
    End If
    GetEbene2List = vReturn
   
        For i = 4 To 8
        With ArtikelSuche
        .Controls("Listbox" & i).Clear
        End With
        Next i
   
End Function

Thanks anyways

Fluff · Jun 22, 2021

Gemitec said:
I have already posted this on Stackoverflow,

Thanks for letting us know, but can you please post a link to your question there, as per the Rule#13. Thanks

Gemitec · Jun 22, 2021

Hello and sorry, here the link