View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
merjet merjet is offline
external usenet poster
 
Posts: 812
Default 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