Home > Software engineering >  Excel VBA code to populate combobox with unique values does not work with number
Excel VBA code to populate combobox with unique values does not work with number

Time:12-16

I am using the following code to populate ComboBox on a userform in vba with unique values. I use the same code to populate two other ComboBoxes and it works fine. It doesn't work when the data in the column is a number. In the same column, if I change the number to a text then it works. How can I get it to work with numbers also?

Sub uniqueYear()
    
Dim myCollection As Collection

On Error Resume Next
Set myCollection = New Collection

    With Me.cbxYear
        .Clear
        For Each cell In Sheets("Sheet1").range("AC2:AC" & Cells(Rows.Count, 1).End(xlUp).Row)
        If Len(cell) <> 0 Then
            Err.Clear
            myCollection.Add cell.Value, cell.Value
            If Err.Number = 0 Then .AddItem cell.Value
            End If
        Next cell
    End With
    
End Sub

CodePudding user response:

I'd extract the job of collecting unique values to a separate method:

Sub uniqueYear()
    
    Dim myCollection As Collection, v, ws As Worksheet
    
    Set ws = ThisWorkbook.Worksheets("Sheet1") 'activeworkbook?
    
    Set myCollection = UniqueCollection(ws.Range("A2:A" & ws.Cells(Rows.Count, 1).End(xlUp).Row))

    With Me.cbxYear
        .Clear
        For Each v In myCollection
            .AddItem v
        Next v
    End With
End Sub

Function UniqueCollection(rng As Range) As Collection
    Dim c As Range, col As New Collection, v
    On Error Resume Next
    For Each c In rng.Cells
        v = c.Value
        If Not IsError(v) Then
            If Len(v) > 0 Then col.Add v, CStr(v) 'Key needs to be a String
        End If
    Next c
    On Error GoTo 0
    Set UniqueCollection = col
End Function

CodePudding user response:

Alternative using a Dictionary

Sub uniqueYear()
    Dim dict As Object, ar, r As Long, k As String
    Set dict = CreateObject("Scripting.Dictionary")
    With Sheets("Sheet1")
        r = .Cells(.Rows.Count, "AC").End(xlUp).Row
        ar = .Range("AC2:AC" & r).Value2
        For r = 1 To UBound(ar)
            k = Trim(ar(r, 1))
            If Len(k) > 0 Then dict(k) = r
        Next
    End With
    Me.cbxYear.List = dict.keys
End Sub
  • Related