N
Nikki
I have a form with three controls ,
lstEmp - Employee Listbox with 3 columns
txtFilter - Text Box
cmdFilter - Button
I have hacked the code from web site examples and the help files.
When the form is opened the list is populated with the entire Employee
List via UserForm_Initialize. This works Correctly.
When I enter a filter value I cannot get the filtered results I want,
see cmdFilter_Click. I dont believe I am doing anything too dificult,
well it shouldnt be. Have done similar things in MS Access but Excel
seems to be a bit more tempermental.
I did get the filtered list working but the list contained a blank row
for all the rows filtered out. I added the list_row variable to control
the list when it is both filtered and not filtered. I cannot get it
working now though.
If anyone can correct, point out, simplify what I am trying to do I
would appreciate it.
Gavin
<< Code below >>
Private Sub cmdFilter_Click()
Dim s_filt As String
s_filt = Me.txtFilter.Value
FillListBox Me.lstEmp, s_filt, 1
End Sub
Private Sub UserForm_Initialize()
FillListBox Me.lstEmp, "", 0
End Sub
Private Sub FillListBox(lb As MSForms.ListBox, filter_text As String,
filter_col As String)
Dim r As Long, c As Long, s As Long
Dim t As Long, x As Long, y As Long
Dim b_add As Boolean
Dim arr_lst()
Dim list_row As Long
Dim RecordSetArray As Variant
Dim strText As String, strValue As String
list_row = 0
RecordSetArray = Range("A3:C1244")
s = LBound(RecordSetArray, 1)
t = UBound(RecordSetArray, 1)
x = LBound(RecordSetArray, 2)
y = UBound(RecordSetArray, 2)
ReDim arr_lst(t - s, y - x)
For r = s + 1 To t
b_add = False
If filter_text = "" Then
b_add = True
list_row = r - s
Else
strValue = RecordSetArray(r, x + filter_col)
strText = Left(strValue, Len(filter_text))
If UCase(filter_text) = UCase(strText) Then
b_add = True
list_row = list_row + 1
End If
End If
If b_add Then
For c = x To y
arr_lst(list_row, c - x) = RecordSetArray(r, c)
Next c
End If
Next r
If list_row > 0 Then
ReDim Preserve arr_lst(list_row, y - x)
With lb
.Clear
.ColumnHeads = True
.List() = arr_lst
.ListIndex = -1 ' no item selected
End With
Else
lb.Clear
MsgBox "Nothing returned"
'Set arr_lst = Nothing
End If
End Sub
lstEmp - Employee Listbox with 3 columns
txtFilter - Text Box
cmdFilter - Button
I have hacked the code from web site examples and the help files.
When the form is opened the list is populated with the entire Employee
List via UserForm_Initialize. This works Correctly.
When I enter a filter value I cannot get the filtered results I want,
see cmdFilter_Click. I dont believe I am doing anything too dificult,
well it shouldnt be. Have done similar things in MS Access but Excel
seems to be a bit more tempermental.
I did get the filtered list working but the list contained a blank row
for all the rows filtered out. I added the list_row variable to control
the list when it is both filtered and not filtered. I cannot get it
working now though.
If anyone can correct, point out, simplify what I am trying to do I
would appreciate it.
Gavin
<< Code below >>
Private Sub cmdFilter_Click()
Dim s_filt As String
s_filt = Me.txtFilter.Value
FillListBox Me.lstEmp, s_filt, 1
End Sub
Private Sub UserForm_Initialize()
FillListBox Me.lstEmp, "", 0
End Sub
Private Sub FillListBox(lb As MSForms.ListBox, filter_text As String,
filter_col As String)
Dim r As Long, c As Long, s As Long
Dim t As Long, x As Long, y As Long
Dim b_add As Boolean
Dim arr_lst()
Dim list_row As Long
Dim RecordSetArray As Variant
Dim strText As String, strValue As String
list_row = 0
RecordSetArray = Range("A3:C1244")
s = LBound(RecordSetArray, 1)
t = UBound(RecordSetArray, 1)
x = LBound(RecordSetArray, 2)
y = UBound(RecordSetArray, 2)
ReDim arr_lst(t - s, y - x)
For r = s + 1 To t
b_add = False
If filter_text = "" Then
b_add = True
list_row = r - s
Else
strValue = RecordSetArray(r, x + filter_col)
strText = Left(strValue, Len(filter_text))
If UCase(filter_text) = UCase(strText) Then
b_add = True
list_row = list_row + 1
End If
End If
If b_add Then
For c = x To y
arr_lst(list_row, c - x) = RecordSetArray(r, c)
Next c
End If
Next r
If list_row > 0 Then
ReDim Preserve arr_lst(list_row, y - x)
With lb
.Clear
.ColumnHeads = True
.List() = arr_lst
.ListIndex = -1 ' no item selected
End With
Else
lb.Clear
MsgBox "Nothing returned"
'Set arr_lst = Nothing
End If
End Sub