I created a small userform.
It had a combobox (for the categories), 4 commandbuttons (Cancel, Ok, Previous,
Next), and a listbox (that is not going to be displayed).
Then I added 5 labels (I was too lazy to create 32 labels).
The combobox was named Combobox1
the commandbuttons: Commandbutton1, ..., commandbutton4
the listbox was named Listbox1
and the 5 labels were Label1, Label2, ..., Label5
I create a worksheet with test data on it. The sheet name was NamesDB.
I put headers in row 1 and test data in a2:ao12. Column A was my category
indicator column.
The userform_initialization routine created a temporary worksheet where I copied
the category column to column A.
Then I used data|filter|Advanced filter to create a list of unique entries in
column B.
Then I deleted column A and sorted the new column A (the unique list) in
ascending order.
Then I populated the combobox with the values from that list and I populated the
listbox with the values from the range of test data (A2:ao12).
This was the code behind the userform:
Option Explicit
Dim MinEntry As Long
Dim MaxEntry As Long
Dim WhichEntry As Long
Const AllCategories As String = "(All)"
Function LookForNextMatch(StartPos As Long, StopPos As Long, StepDir As Long)
Dim iCtr As Long
If StepDir = -1 Then
StartPos = StartPos - 1
Else
StartPos = StartPos + 1
End If
With Me.ListBox1
For iCtr = StartPos To StopPos Step StepDir
If LCase(Me.ComboBox1.Value) = LCase(.List(iCtr, 0)) _
Or LCase(Me.ComboBox1.Value) = LCase(AllCategories) Then
'it's a match
WhichEntry = iCtr
'stop looking
Exit For
End If
Next iCtr
End With
End Function
Function DisplayTheRecord(WhichOne As Long)
Dim iCtr As Long
'I used 5 labels in my little userform
For iCtr = 1 To 5
'populate with the first item in the list
Me.Controls("Label" & iCtr).Caption _
= Me.ListBox1.List(WhichOne, iCtr - 1)
Next iCtr
If WhichOne = MaxEntry Then
Me.CommandButton4.Enabled = False
Else
Me.CommandButton4.Enabled = True
End If
If WhichOne = MinEntry Then
Me.CommandButton3.Enabled = False
Else
Me.CommandButton3.Enabled = True
End If
End Function
Private Sub ComboBox1_Change()
Dim iCtr As Long
WhichEntry = -999 'can't be chosen
MinEntry = -999
MaxEntry = -999
With Me.ListBox1
For iCtr = 0 To .ListCount - 1
If LCase(Me.ComboBox1.Value) = LCase(.List(iCtr, 0)) _
Or LCase(Me.ComboBox1.Value) = LCase(AllCategories) Then
'it's a match
'keep track of first matching entry
If MinEntry < 0 Then
MinEntry = iCtr
WhichEntry = iCtr
End If
'keep track of last matching entry
MaxEntry = iCtr
End If
Next iCtr
End With
Call DisplayTheRecord(WhichOne:=WhichEntry)
End Sub
Private Sub CommandButton1_Click()
'cancel button
Unload Me
End Sub
Private Sub CommandButton2_Click()
'ok button
MsgBox "ok"
End Sub
Private Sub CommandButton3_Click()
'previous button
If WhichEntry < MinEntry Then
'this shouldn't happen!
Exit Sub
End If
Call LookForNextMatch(StartPos:=WhichEntry, _
StopPos:=MinEntry, _
StepDir:=-1)
Call DisplayTheRecord(WhichOne:=WhichEntry)
End Sub
Private Sub CommandButton4_Click()
'next button
If WhichEntry > MaxEntry Then
'this shouldn't happen!
Exit Sub
End If
Call LookForNextMatch(StartPos:=WhichEntry, _
StopPos:=MaxEntry, _
StepDir:=1)
Call DisplayTheRecord(WhichOne:=WhichEntry)
End Sub
Private Sub UserForm_Initialize()
Dim wks As Worksheet
Dim myRng As Range
Dim LastRow As Long
Dim TempWks As Worksheet
Dim myCateRng As Range
Dim iCtr As Long
Set wks = Worksheets("NamesDB")
With wks
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set myRng = .Range("a2:AO" & LastRow)
End With
Application.ScreenUpdating = False
Set TempWks = Worksheets.Add
'create list of unique categories based on column 1
myRng.Columns(1).Copy
With TempWks
'add a header to this sheet (ignore the header on the sheet)
.Range("A1").Value = AllCategories
'this will have all the entries
.Range("A2").PasteSpecial Paste:=xlPasteValues
'just the unique entries
.Range("A1").EntireColumn.AdvancedFilter _
Action:=xlFilterCopy, _
criteriarange:="", _
copytorange:=.Range("b1"), _
unique:=True
'done with column A (with all the entries
.Columns(1).Delete
'put it in nice sorted order
.Columns.Sort _
key1:=.Columns(1), order1:=xlAscending, header:=xlYes
Set myCateRng = .Range("A1", .Cells(.Rows.Count, "A").End(xlUp))
End With
With Me.ListBox1
.Visible = True 'false when done testing
.ColumnCount = myRng.Columns.Count
.List = myRng.Value
End With
With Me.ComboBox1
.List = myCateRng.Value
.ListIndex = 0
End With
With Me.CommandButton1
.Caption = "Cancel"
.Enabled = True
.Cancel = True
End With
With Me.CommandButton2
.Enabled = True
.Caption = "Ok"
End With
With Me.CommandButton3
.Enabled = False 'there is no previous right now
.Caption = "Previous"
End With
With Me.CommandButton4
.Enabled = True
.Caption = "Next"
End With
With Application
.DisplayAlerts = False
TempWks.Delete
.DisplayAlerts = True
.ScreenUpdating = True
End With
End Sub
And it seemed to work fine.