Need Help Please-Filtering

  • Thread starter Thread starter Pantelis
  • Start date Start date
P

Pantelis

Hi all,

I am creating a bunch of combo boxes which I would like them to work in the
same way as a filter in excel.

I have a sheet with a bunch of headings say "state", "restaurants" and "food
offered".

Each state has a number of restaurants that can be common i.e. wimpy,
BigMac, King.

So I want to put a combobox that when I select a "State" it will filter all
the restaurants in that state and only shows those restaurants in the second
combobox and then when I choose the restaurant in the specific state it will
show me the various foods available in that restaurant in the next combo
box.

Thank you for anybodies help in advance.......

Really stuck here!!!

Pantelis
 
there is no magic built in support for this. You would have to write code
to do all this

I would put my data on a worksheet as a database and use the Autofilter to
do the filtering (as the user makes a selection, set the criteria in the
autofilter for that column) - then populate the next box by looping through
the visible cells and using additem.
 
of course, 50 states x 25 restaurants x 25 items = 31250 rows as a level of
magnitude check. Unless this is some toy problem for a school assignment or
something, Excel may not be the medium where you want to store your data.
 
Headers for all data are in row 1, starting in column A

On sheet3 I have the data

State Restaurant Food
AL BK A
AL BK B
AL WIMPY C
AL WIMPY B
AL WIMPY D
AL MC A
AL MC D
AR HARD A
AR HARD F
.. . .

on Sheet 3a I have a list of unique states (preprocessed for speed).
State
AL
AR
.. . .

I have a userform with 3 comboboxes. In the Userform Code:

Option Explicit
Dim Data As Range
Dim LowestLevel As Long


Private Sub ComboBox1_click()
Dim rng As Range, cell As Range
Dim res As Variant
Dim varr() As String
Dim icnt As Long
Dim bFirst As Boolean
ReDim varr(1 To 50)
If ComboBox1.ListIndex <> -1 Then
If LowestLevel > 1 Then
Data.Parent.ShowAllData
End If
Worksheets("Sheet3").AutoFilter.Range _
.AutoFilter Field:=1, _
Criteria1:=ComboBox1.Value
LowestLevel = 2
ComboBox2.Clear
On Error Resume Next
Set rng = Data.Columns(2).SpecialCells(xlVisible)
On Error GoTo 0
bFirst = True
For Each cell In rng
If bFirst Then
ComboBox2.AddItem cell.Value
icnt = 1
varr(icnt) = cell.Value
bFirst = False
Else
res = Application.Match(cell.Value, varr, 0)
If IsError(res) Then
icnt = icnt + 1
varr(icnt) = cell.Value
ComboBox2.AddItem cell.Value
If icnt = UBound(varr) Then _
ReDim Preserve varr(1 To UBound(varr) + 50)
End If
End If
Next
Else
ComboBox2.Clear
ComboBox2.ListIndex = -1
End If
End Sub

Private Sub ComboBox2_click()
Dim rng As Range, cell As Range
Dim varr() As String
Dim res As Variant
Dim bFirst As Boolean
Dim icnt As Long
ReDim varr(1 To 50)
If ComboBox1.ListIndex <> -1 And _
ComboBox2.ListIndex <> -1 Then
If LowestLevel > 2 Then
Data.Parent.ShowAllData
Worksheets("Sheet3").AutoFilter.Range _
.AutoFilter Field:=1, _
Criteria1:=ComboBox1.Value
End If
Worksheets("Sheet3").AutoFilter.Range _
.AutoFilter Field:=2, _
Criteria1:=ComboBox2.Value
LowestLevel = 3
ComboBox3.Clear
On Error Resume Next
Set rng = Data.Columns(3).SpecialCells(xlVisible)
On Error GoTo 0
bFirst = True
For Each cell In rng
If bFirst Then
ComboBox3.AddItem cell.Value
icnt = 1
varr(icnt) = cell.Value
bFirst = False
Else
res = Application.Match(cell.Value, varr, 0)
If IsError(res) Then
icnt = icnt + 1
varr(icnt) = cell.Value
ComboBox3.AddItem cell.Value
If icnt = UBound(varr) Then _
ReDim Preserve varr(1 To UBound(varr) + 50)
End If
End If
Next
Else
ComboBox3.Clear
ComboBox3.ListIndex = -1
End If
End Sub

Private Sub UserForm_Initialize()
Dim rng As Range
With Worksheets("Sheet3a")
Set rng = .Cells(1, 1).CurrentRegion.Columns(1)
Set rng = rng.Offset(1, 0).Resize(rng.Rows.Count - 1)
End With
ComboBox1.RowSource = rng.Address(external:=True)
With Worksheets("Sheet3")
Set rng = .Cells(1, 1).CurrentRegion
If Not .AutoFilterMode Then
rng.AutoFilter
Else
If .FilterMode Then
.ShowAllData
End If
End If
Set Data = .AutoFilter.Range
Set Data = Data.Offset(1, 0).Resize( _
Data.Rows.Count - 1)
End With
End Sub
 
Tom or anyone that can be of help,

The below code provided to me by Tom works well, however, when I select a
state say that has not got a restaurant I get a debug error. Could someone
provide me with a suggestion.

In adition, in the third combo box once I select one of the available foods,
on the spreadsheet where it filters the data it still shows all the food
selections for the respective restaurant.

Thanks to any help in advance
Pantelis
 
I didn't set up the third combobox to work with the data on the sheet. I
was only using that data to feed the comboboxes. Also, I assumed you
wouldn't have a state with no restaurants.

I will see if I can take a look at it tonight.
 
Here is a revision:

Option Explicit
Dim Data As Range
Dim LowestLevel As Long
Private Sub ComboBox1_click()
Dim rng As Range, cell As Range
Dim res As Variant
Dim varr() As String
Dim icnt As Long
Dim bFirst As Boolean
ReDim varr(1 To 50)
If ComboBox1.ListIndex <> -1 Then
If LowestLevel > 1 Then
Data.Parent.ShowAllData
End If
Worksheets("Sheet3").AutoFilter.Range _
.AutoFilter Field:=1, _
Criteria1:=ComboBox1.Value
LowestLevel = 2
ComboBox2.Clear
ComboBox3.Clear
On Error Resume Next
Set rng = Data.Columns(2).SpecialCells(xlVisible)
On Error GoTo 0
bFirst = True
If rng Is Nothing Then
ComboBox2.Clear
ComboBox3.Clear
Exit Sub
End If
For Each cell In rng
If bFirst Then
ComboBox2.AddItem cell.Value
icnt = 1
varr(icnt) = cell.Value
bFirst = False
Else
res = Application.Match(cell.Value, varr, 0)
If IsError(res) Then
icnt = icnt + 1
varr(icnt) = cell.Value
ComboBox2.AddItem cell.Value
If icnt = UBound(varr) Then _
ReDim Preserve varr(1 To UBound(varr) + 50)
End If
End If
Next
Else
ComboBox2.Clear
ComboBox2.ListIndex = -1
End If
End Sub

Private Sub ComboBox2_click()
Dim rng As Range, cell As Range
Dim varr() As String
Dim res As Variant
Dim bFirst As Boolean
Dim icnt As Long
ReDim varr(1 To 50)
If ComboBox1.ListIndex <> -1 And _
ComboBox2.ListIndex <> -1 Then
If LowestLevel > 2 Then
Data.Parent.ShowAllData
Worksheets("Sheet3").AutoFilter.Range _
.AutoFilter Field:=1, _
Criteria1:=ComboBox1.Value
End If
Worksheets("Sheet3").AutoFilter.Range _
.AutoFilter Field:=2, _
Criteria1:=ComboBox2.Value
LowestLevel = 3
ComboBox3.Clear
On Error Resume Next
Set rng = Data.Columns(3).SpecialCells(xlVisible)
On Error GoTo 0
If rng Is Nothing Then
ComboBox3.Clear
Exit Sub
End If
bFirst = True
For Each cell In rng
If bFirst Then
ComboBox3.AddItem cell.Value
icnt = 1
varr(icnt) = cell.Value
bFirst = False
Else
res = Application.Match(cell.Value, varr, 0)
If IsError(res) Then
icnt = icnt + 1
varr(icnt) = cell.Value
ComboBox3.AddItem cell.Value
If icnt = UBound(varr) Then _
ReDim Preserve varr(1 To UBound(varr) + 50)
End If
End If
Next
Else
ComboBox3.Clear
ComboBox3.ListIndex = -1
End If
End Sub

Private Sub ComboBox3_click()
If ComboBox1.ListIndex <> -1 And _
ComboBox2.ListIndex <> -1 And _
ComboBox3.ListIndex <> -1 Then
If LowestLevel > 2 Then
Data.Parent.ShowAllData
Worksheets("Sheet3").AutoFilter.Range _
.AutoFilter Field:=1, _
Criteria1:=ComboBox1.Value
Worksheets("Sheet3").AutoFilter.Range _
.AutoFilter Field:=2, _
Criteria1:=ComboBox2.Value
End If
Worksheets("Sheet3").AutoFilter.Range _
.AutoFilter Field:=3, _
Criteria1:=ComboBox3.Value
LowestLevel = 3
Else
ComboBox3.Clear
ComboBox3.ListIndex = -1
End If
End Sub

Private Sub UserForm_Initialize()
Dim rng As Range
With Worksheets("Sheet3a")
Set rng = .Cells(1, 1).CurrentRegion.Columns(1)
Set rng = rng.Offset(1, 0).Resize(rng.Rows.Count - 1)
End With
ComboBox1.RowSource = rng.Address(external:=True)
With Worksheets("Sheet3")
Set rng = .Cells(1, 1).CurrentRegion
If Not .AutoFilterMode Then
rng.AutoFilter
Else
If .FilterMode Then
.ShowAllData
End If
End If
Set Data = .AutoFilter.Range
Set Data = Data.Offset(1, 0).Resize( _
Data.Rows.Count - 1)
End With
End Sub
 
Tom

Perfect it woks fine, now if you can do me one more favour you will make my
day.

I need to copy the filtered row to say row 100 of the same sheet, could you
please help.

Thanks in advance

Pantelis
 
Back
Top