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.



pb100 wrote:

Hello,
I have a client who has a list of vendor contact information. They would
like to be able to filter the list by category and have each contact show up
in a rolodex type of format. I am able to have the list filter dynamically
with a combo box control but how could I display one contact at a time with
next and previous buttons that would show only the filtered results? Been
wracking my brain trying to come up with a solution the last few days. Tried
Data forms but their data has more than 32 columns and the client really
wants a nicely formatted result. Thanks in advance for any suggestions!

--

Dave Peterson