I need to populate a combobox based on a column on a worksheet

Question

I have a combobox on a userform that is currently populated by a column in a table. Column A This column has a tooling number where two numbers can be exactly the same except for the letter on the end. (Cells A5 and A6 for example) how can I populate the combobox so that it only includes the latest version of that number?

Answer 1

Populate Combo Box Unique with a Twist

• Adjust the first cell address, the worksheet, and the combo box.

Option Explicit

Sub PopulateComboUnique()
    
    Const First As String = "A2"
    
    Dim rg As Range: Set rg = RefColumn(Sheet1.Range(First))
    If rg Is Nothing Then Exit Sub ' empty column range
    
    Dim sData As Variant: sData = GetColumnRange(rg)
    
    Dim dData As Variant: dData = ArrUniqueSpecial(sData)
    If IsEmpty(dData) Then Exit Sub ' no unique values
        
    Sheet1.ComboBox1.List = dData
    
'    Dim n As Long
'    For n = LBound(dData) To UBound(dData)
'        Debug.Print dData(n)
'    Next n
        
End Sub

Function RefColumn( _
    ByVal FirstCellRange As Range) _
As Range
    If FirstCellRange Is Nothing Then Exit Function
    With FirstCellRange.Cells(1)
        Dim lCell As Range
        Set lCell = .Resize(.Worksheet.Rows.Count - .Row + 1) _
            .Find("*", , xlFormulas, , , xlPrevious)
        If lCell Is Nothing Then Exit Function
        Set RefColumn = .Resize(lCell.Row - .Row + 1)
    End With
End Function

Function GetColumnRange( _
    ByVal rg As Range) _
As Variant
    If rg Is Nothing Then Exit Function
    Dim cData As Variant
    With rg.Columns(1)
        If .Rows.Count = 1 Then
            ReDim cData(1 To 1, 1 To 1): cData(1, 1) = .Value
        Else
            cData = .Value
        End If
    End With
    GetColumnRange = cData
End Function

Function ArrUniqueSpecial( _
    ByVal sData As Variant) _
As Variant
    If IsEmpty(sData) Then Exit Function
   
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare
    
    Dim Key As Variant
    Dim r As Long
    
    For r = 1 To UBound(sData, 1)
        Key = sData(r, 1)
        If Not IsError(Key) Then
            If Len(Key) > 1 Then ' not allowing zero or one character
                dict(Left(Key, Len(Key) - 1)) = Right(Key, 1)
            End If
        End If
    Next r
    If dict.Count = 0 Then Exit Function
    
    Dim dData() As String: ReDim dData(1 To dict.Count)
    
    r = 0
    For Each Key In dict.Keys
        r = r + 1
        dData(r) = Key & dict(Key)
    Next Key

    ArrUniqueSpecial = dData
End Function