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

Question

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 kina data is found I get this error):

Option Explicit

Private Sub UserForm_Initialize()
    Dim Hauptkategorie() As Variant
    
    Me.Caption = "Artikelsuche"
    ClearFilter
    
    ' Get array of cities and apply to listbox
    Hauptkategorie = GetHauptkategorieList()
    ListBox1.List = Hauptkategorie
    
    'LoadAllDataToDataList

End Sub

' Return list of Hauptkategorie
Private Function GetHauptkategorieList() As Variant
    Dim rngData As Range, rngCrit As Range, rngExt As Range
    Dim vReturn As Variant
    Dim i As Integer
    
    Set rngData = ArtikelDatasource.Range("A1").CurrentRegion
    Set rngCrit = CategoryCriteria.Range("B1:B2")
    Set rngExt = CategoryCriteria.Range("B6")
    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
        vReturn = rngExt.Resize(rngExt.Rows.Count - 1).Offset(1)
    Else
        'Use this to return "no data" message
        vReturn = noDataArray()
    End If
    GetHauptkategorieList = vReturn
        
        For i = 2 To 8
        With ArtikelSuche
        .Controls("Listbox" & i).Clear
        End With
        Next i
    
End Function

Private Sub ListBox1_Change()
    Dim rngData As Range, rngCrit As Range, rngExt As Range
    Dim Ebene1kategorie() As Variant
    
    CategoryCriteria.Range("C2").ClearContents
    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 ListBox1.ListIndex = -1 Then Exit Sub   ' nothing is selected, so quit
    Debug.Print ListBox1.List(ListBox1.ListIndex)

    CategoryCriteria.Range("A2").Value = ListBox1.List(ListBox1.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
       Set rngData = rngData.Resize(rngData.Rows.Count - 1).Offset(1)
       'ListBox2.RowSource = "'" & rngData.Parent.Name & "'!" & rngData.Address
    Else
        Debug.Print "Error, No data for given list item, which is kinda strange...."
        Exit Sub
    End If
    'ListBox2.Clear
    Ebene1kategorie = GetEbene1List()
    ListBox2.List = Ebene1kategorie
    ListBox2.ListIndex = -1
End Sub

Private Function GetEbene1List() 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("d1:d2")
    Set rngExt = CategoryCriteria.Range("d6")
    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
        vReturn = rngExt.Resize(rngExt.Rows.Count - 1).Offset(1)
    Else
        ' Use this to return "no data" message
        vReturn = noDataArray()
    End If
    GetEbene1List = vReturn
    
        For i = 3 To 8
        With ArtikelSuche
        .Controls("Listbox" & i).Clear
        End With
    Next i
    
End Function

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

(and the code goes further like this: the listboxes are all done in this way)

Answer 1

When you assign the value of a range to a variant Excel will create a string or numeric value if the range comprises a single cell, or an array if there are more than one cell in the range. Try this test:-

Private Sub TestArray()
    ' 271

    Dim Arr1            As Variant
    Dim Arr2            As Variant
    
    With ActiveSheet
        Arr1 = .Range(.Cells(1, 1), .Cells(1, 1)).Value
        Arr2 = .Range(.Cells(1, 1), .Cells(2, 1)).Value
    End With
    
    Debug.Print VarType(Arr1), VarType(Arr2)
End Sub

VarType(Arr1) will return 5 or 8 (numeric or string), depending upon what cell A1 contains, and 8204 for Arr2 . Any number below 8200 indicates that the variant is not an object. Debug.Print Arr1(1, 1) will return an error because Arr1 isn't an array.

In the procedure below the above test is incorporated. If the filter returned a single item and vReturn therefore is not an array the code converts the value to an array and assigns the single value to it. In consequence, vReturn(1, 1) will not throw an error as it did while this treatment was omitted.

Private Function GetEbeneList(ByVal Clm As Long) As Variant
    ' 271
    ' Clm = 4 (column D) or 6 (column F)
    
    Dim vReturn As Variant
    Dim Tmp     As Variant
    Dim rngData As Range, rngCrit As Range, rngExt As Range
    Dim i       As Integer

    Set rngData = ArticleCriteria.Range("A6").CurrentRegion
    With CategoryCriteria
        Set rngCrit = .Range(.Cells(1, Clm), .Cells(2, Clm))
        Set rngExt = .Cells(6, Clm)
    End With
    
    rngData.AdvancedFilter xlFilterCopy, rngCrit, rngExt, True
    With rngExt.CurrentRegion
        If .Rows.Count > 1 Then
            ' Sort the cities ascending
            .Sort Key1:=.Resize(1, 1), Header:=xlYes, Order1:=xlAscending
            vReturn = .Resize(.Rows.Count - 1).Offset(1).Value
        Else
            ' Use this to return "no data" message
            vReturn = noDataArray()
        End If
    End With

    If VarType(vReturn) < 8200 Then
        Tmp = vReturn
        ReDim vReturn(1 To 1)
        vReturn(1, 1) = Tmp
    End If
    GetEbeneList = vReturn
    
    For i = 3 To 8
        ArtikelSuche.Controls("Listbox" & i).Clear
    Next i
End Function

The code is untested (last, not least, because I don't have your function NoDataArra() ) and may therefore contain bugs for which I apologize. To compensate, I have made some changes.

Basically, your functions GetEbene1List and GetEbene2List are identical except for the column they refer to. Instead of creating 2 functions, one would create one and supply the column variable as an argument. This idea is incorporated above.

So, instead of your existing function call ...

Ebene1kategorie = GetEbene1List()
ListBox2.List = Ebene1kategorie
ListBox2.ListIndex = -1

You should now call ...

With ListBox2
    .List = EbeneKategorie(4)
    .ListIndex = -1
End With

There are more syntax changes in the code that don't need explanation. They just offer more opportunity for typos and logical errors to have crept in :-)

Answer 2

Thank you sooo much for investing your time into my question. I really had to come to this group and ask professionals, because I was soo stucked, and I will be very honest: i have really really basic idea of programming. I do also Arduino, joomla etc, but all hobby stuff. My aim was actually to have a bunch of Data from Columne A:X (as an example) and have a Userform with X listboxes. What the first listbox does, it actually checks all the Values in Column A and only display those who are diffrent from eachother, lets say you have 400 rows, only 3 different Values, so Listbox 1 has 3 Rows in this case. If you click a row in the Listbox1, then the Columne B will be Checked according to what was selected in Listbox1, so in this case Columne A and Listbox 2 only shows the next value so on...

This way you can have a cool Search system. I found this gentlemans Idea cool regarding the cities, so I came home today after work and solved it.

I solved it on a nooby way, but it works. And I will try your solution as well.

This is how I did it :( (just showing you 1 Listbox and the function). Yes I used errorhandle. Let me know your thinking about this solution :)

Kind regards

Private Sub ListBox2_Change()

Dim rngData As Range, rngCrit As Range, rngExt As Range
Dim Ebene2kategorie() As Variant
Dim Ebene2kategorie2(1 To 1, 1 To 1) 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

   Set rngData = rngData.Resize(rngData.Rows.Count - 1).Offset(1)
   
Else

    Debug.Print "Error, No data for given list item, which is kinda strange...."
    Exit Sub
End If

On Error GoTo zero

    Ebene2kategorie() = GetEbene2List()
    ListBox3.List = Ebene2kategorie
    ListBox3.ListIndex = -1
    Exit Sub

zero:
    Ebene2kategorie2(1, 1) = GetEbene2List()
    ListBox3.List = Ebene2kategorie2

On Error GoTo 0

ListBox3.ListIndex = -1

End Sub

…

Private Function GetEbene2List() As Variant

Dim rngData As Range, rngCrit As Range, rngExt As Range

Dim vReturn2(1 To 1, 1 To 1) As Variant
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 And rngExt.Rows.Count < 3 Then

    vReturn2(1, 1) = rngExt.Resize(rngExt.Rows.Count - 1).Offset(1)
    GetEbene2List = vReturn2(1, 1)

ElseIf rngExt.Rows.Count > 1 Then

    vReturn = rngExt.Resize(rngExt.Rows.Count - 1).Offset(1)
    GetEbene2List = vReturn
        
Else
    ' Use this to return "no data" message

    vReturn2(1, 1) = noDataArray()

End If

    For i = 4 To 8
    With ArtikelSuche
    .Controls("Listbox" & i).Clear
    End With
    Next i

End Function