Populate ListBox with Filtered Records

[mikeg710]

Using Excel 2003.

I have a database worksheet named Projects, with three columns of
information: Id, Name, and Location. The worksheet currently has over 200
records.

My VBA form (frmMainMenu) has a ComboBox (cboSelectLocation), CommandButton
(cmdListProjects), and a ListBox (lstProjectsByLocation).

Using the VBA code example from http://j-walk.com/ss/excel/tips/tip47.htm, I
am able to populate the ComboBox with a list of unique, nonduplicated
Locations from the Projects worksheet.

What I am getting stuck on is when the user selects the Location from the
ComboBox, clicking the CommandButton should populate the ListBox with all the
records that match the Location (a filtered list by Location, if you will).

Can anyone help with the VBA code that would sort through the records of the
worksheet to select only the ones that match the Location?

 

[Halim]

Hi,

I've created this one:
Sub FindTxt()
Dim FindX As Object
Dim FindTxt As String
Dim FindLoop As Object
Dim FindNextx As Object
Dim FindLoopAddr As Object
Dim Teks As String, R As Long
ListBox1.ColumnCount = 2
ListBox1.Clear
FindTxt = TextBox1.Text
'On Error GoTo Err

Set FindLoopAddr = Cells
Set FindX = FindLoopAddr.Find(FindTxt, LookIn:=xlValues, LookAt:=xlPart,
SearchOrder:=xlByRows)

If Not FindX Is Nothing Then
ListBox1.AddItem FindX.Address
ListBox1.List(0, 1) = FindX.Value
'To handle next search ... until looped to the begining search :
Set FindNextx = FindX
Do
Set FindLoop = FindLoopAddr.FindNext(After:=FindNextx)
If Not FindLoop Is Nothing Then
ListBox1.AddItem FindLoop.Address
R = R + 1
ListBox1.List(R, 1) = FindLoop.Value
If FindLoop.Offset(0, -(FindLoop.Column - 1)).Value <> ""
Then _
ListBox1.List(R, 2) = _
FindLoop.Offset(0, -(FindLoop.Column - 1)).Value

'To handle if trapped in loop :
If FindLoop.Value = "" Then
ListBox1.Clear
Exit Do
End If

End If
Set FindNextx = FindLoop
Loop Until FindNextx.Address = FindX.Address

'To handle if loop is get the same value as begining :
If ListBox1.ListCount > 0 Then
ListBox1.RemoveItem ListBox1.ListCount - 1
ListBox1.ListIndex = 0
End If

End If
Err:
End Sub

just change FindTxt = TextBox1.Text
to FindTxt = ComboBox1.Text

and note ListBox1 is avalilabe

 

[mikeg710]

Thank you much!

Hi,

I've created this one:
Sub FindTxt()
Dim FindX As Object
Dim FindTxt As String
Dim FindLoop As Object
Dim FindNextx As Object
Dim FindLoopAddr As Object
Dim Teks As String, R As Long
ListBox1.ColumnCount = 2
ListBox1.Clear
FindTxt = TextBox1.Text
'On Error GoTo Err

Set FindLoopAddr = Cells
Set FindX = FindLoopAddr.Find(FindTxt, LookIn:=xlValues, LookAt:=xlPart,
SearchOrder:=xlByRows)

If Not FindX Is Nothing Then
ListBox1.AddItem FindX.Address
ListBox1.List(0, 1) = FindX.Value
'To handle next search ... until looped to the begining search :
Set FindNextx = FindX
Do
Set FindLoop = FindLoopAddr.FindNext(After:=FindNextx)
If Not FindLoop Is Nothing Then
ListBox1.AddItem FindLoop.Address
R = R + 1
ListBox1.List(R, 1) = FindLoop.Value
If FindLoop.Offset(0, -(FindLoop.Column - 1)).Value <> ""
Then _
ListBox1.List(R, 2) = _
FindLoop.Offset(0, -(FindLoop.Column - 1)).Value

'To handle if trapped in loop :
If FindLoop.Value = "" Then
ListBox1.Clear
Exit Do
End If

End If
Set FindNextx = FindLoop
Loop Until FindNextx.Address = FindX.Address

'To handle if loop is get the same value as begining :
If ListBox1.ListCount > 0 Then
ListBox1.RemoveItem ListBox1.ListCount - 1
ListBox1.ListIndex = 0
End If

End If
Err:
End Sub

just change FindTxt = TextBox1.Text
to FindTxt = ComboBox1.Text

and note ListBox1 is avalilabe

--

Regards,

Halim