Populate combobox with unique value from a range

[haseft]

hej,
I want to populate combobox with unique value from a range.
the code working not properly, combobox not sorted and fylls allso with empty line (se the result/picture), (the code works only if the value is in a column and do not hanve eny empy cell)
thanks for help,
here is the code and the data.

Dim UfDic As Object
Dim Cl As Range

Set UfDic = CreateObject("scripting.dictionary")
UfDic.CompareMode = 1
With Sheets("Sheet1")
  For Each Cl In .Range("AG2", "AI17")
    If Not UfDic.exists(Cl.Value) Then UfDic.Add Cl.Value, CreateObject("scripting.dictionary")
      Set UfDic(Cl.Value)(Cl.Offset(, -1).Value) = Cl
  Next Cl
End With
Me.Page8ComboBox1.List = UfDic.keys

Year1	Year2	Year3
2017	2018	2019
2020	2021	2022
2020	2021	2022
2018
2015
2016
2017	2018
2020
2015
2016
2017
2018	2019	2020
2019
2019
2018
2021	2022

 

[GWteB]

How about this. Note the separate function.

Sub haseft()

    Dim Dic As Object
    Dim Cl As Range
    Set Dic = CreateObject("scripting.dictionary")
    With Sheets("Sheet1")
        For Each Cl In .Range("AG2:AI17")
            On Error Resume Next
            Dic.Add Cl.Value, "dummy"
            On Error GoTo 0
        Next Cl
    End With

    Dim arr As Variant
    arr = Dic.keys
    arr = Sort1DArray(arr)
    Me.Page8ComboBox1.List = arr
End Sub


Public Function Sort1DArray(ByVal argArr As Variant) As Variant

    Dim arrList As Object, Itm As Variant, i As Long, n As Long
    Set arrList = CreateObject("System.Collections.ArrayList")
    For Each Itm In argArr
        If Not IsEmpty(Itm) Then
            arrList.Add Itm
        Else
            n = n + 1
        End If
    Next Itm
    arrList.Sort
    For Each Itm In arrList
        argArr(i) = Itm
        i = i + 1
    Next Itm
    ReDim Preserve argArr(UBound(argArr) - n)
    Sort1DArray = argArr
End Function

 

[mumps]

Try:

Private Sub UserForm_Initialize()
    Dim r As Long, c As Long
    Dim arr As Variant, LST As Object, item As Variant
    arr = Sheets("Sheet1").Range("AG2:AG17").Resize(, 3).Value
    Set LST = CreateObject("system.collections.arraylist")
    For r = 1 To UBound(arr)
         For c = 1 To UBound(arr, 2)
             If Not LST.contains(arr(r, c)) And arr(r, c) <> "" Then
                 LST.Add (arr(r, c))
             End If
       Next c
    Next r
    LST.Sort
    For Each item In LST
       Page8ComboBox1.AddItem item
    Next item
End Sub

 

[haseft]

How about this. Note the separate function.

Sub haseft()

    Dim Dic As Object
    Dim Cl As Range
    Set Dic = CreateObject("scripting.dictionary")
    With Sheets("Sheet1")
        For Each Cl In .Range("AG2:AI17")
            On Error Resume Next
            Dic.Add Cl.Value, "dummy"
            On Error GoTo 0
        Next Cl
    End With

    Dim arr As Variant
    arr = Dic.keys
    arr = Sort1DArray(arr)
    Me.Page8ComboBox1.List = arr
End Sub


Public Function Sort1DArray(ByVal argArr As Variant) As Variant

    Dim arrList As Object, Itm As Variant, i As Long, n As Long
    Set arrList = CreateObject("System.Collections.ArrayList")
    For Each Itm In argArr
        If Not IsEmpty(Itm) Then
            arrList.Add Itm
        Else
            n = n + 1
        End If
    Next Itm
    arrList.Sort
    For Each Itm In arrList
        argArr(i) = Itm
        i = i + 1
    Next Itm
    ReDim Preserve argArr(UBound(argArr) - n)
    Sort1DArray = argArr
End Function

hej GW,
I put the codes haseft() in a Private Sub UserForm_Initialize()
and the codes for funktion above it.

i get error (se the Picture),
it point at the code bellow,

Set arrList = CreateObject("System.Collections.ArrayList")

 

[GWteB]

I see. That's caused by a missing type library file. To be specific, you need a file called mscorlib.dll, which file is part of the .NET-framework.
Apparently your system does not have this, at least not the correct version. You need .Net Framework 3.5 for this to work. Most Windows systems are equipped with this.
Since you already used code using the scripting library I assumed you were on Windows (on Apple MacOS both scripting and collections will not work ...)

 

[haseft]

Try:

Private Sub UserForm_Initialize()
    Dim r As Long, c As Long
    Dim arr As Variant, LST As Object, item As Variant
    arr = Sheets("Sheet1").Range("AG2:AG17").Resize(, 3).Value
    Set LST = CreateObject("system.collections.arraylist")
    For r = 1 To UBound(arr)
         For c = 1 To UBound(arr, 2)
             If Not LST.contains(arr(r, c)) And arr(r, c) <> "" Then
                 LST.Add (arr(r, c))
             End If
       Next c
    Next r
    LST.Sort
    For Each item In LST
       Page8ComboBox1.AddItem item
    Next item
End Sub

hi mumps,
i get error massage (se picture)

 

[GWteB]

I'm sure @mumps will give you the same answer .....

 

[Fluff]

You can download the .Net Framework 3.5 from here Download Microsoft .NET Framework 3.5 from Official Microsoft Download Center

 

[mumps]

Try @Fluff's solution and let us know how it works out.

 

[haseft]

T

You can download the .Net Framework 3.5 from here Download Microsoft .NET Framework 3.5 from Official Microsoft Download Center

Thanks all,
I download the file and try it igen,