Fill ComboBox with unique items
The 2's in the following assume the worksheet has a header row.
Private Sub UserForm_Activate()
Dim iEnd As Long
Dim aCat() As String
Dim i As Long
Dim iCt As Long
Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
iEnd = ws.Cells(65536, "A").End(xlUp).Row
ReDim aCat(1 To iEnd)
For i = 2 To iEnd
If IsError(Application.Match(ws.Cells(i, "A"), aCat, 0)) Then
iCt = iCt + 1
aCat(iCt) = ws.Cells(i, "A")
End If
Next i
ReDim Preserve aCat(1 To iCt)
cbxCategory.List = aCat
End Sub
Private Sub cbxCategory_Change()
Dim iEnd As Long
Dim c As Range
Dim rng As Range
Dim ws As Worksheet
cbxSubcategory.Clear
Set ws = Worksheets("Sheet1")
iEnd = ws.Cells(65536, "A").End(xlUp).Row
Set rng = ws.Range("A2:A" & iEnd)
For Each c In rng
If c = cbxCategory Then _
cbxSubcategory.AddItem c.Offset(0, 1)
Next c
End Sub
|