I have a userform with one TextBox and One ListBox.
TextBox1 is for type query and ListBox1 for Search Result.
A data sheet is named "DAY BOOK", where column D and H are a date fields.
Below code works well, but displaying the search result
also required: First column of the DAY BOOK sheet empty.
As newby any help will be appreciated.
Private Const LISTBOX_COL_COUNT As Long = 12
'Option Explicit
'Public EnableEvents As Boolean
Public iWidth As Integer
Public iHeight As Integer
Public iLeft As Integer
Public iTop As Integer
Public bState As Boolean
Dim BlnVal As Boolean
Private Sub TextBox1_Change()
PopulateListbox "*" & TextBox1.Text & "*"
End Sub
Private Sub userform_activate()
With ListBox1
.ColumnHeads = True
.ColumnCount = LISTBOX_COL_COUNT
'.ColumnWidths = "20,35,70,50,50,60,60,50,50,0,0,60,60,60,0,60,60,40,35,60,45,60,60"
End With
PopulateListbox
TextBox1.SetFocus
End Sub
Private Sub PopulateListbox(Optional removeItem As String = vbNullString)
Dim rng As Range
Dim v() As Variant, listItems() As Variant
Dim rowNum As Variant
Dim rowList As Collection
Dim r As Long, c As Long
Dim itemText As String
Dim isMatch As Boolean
On Error GoTo pvs:
'Define the target range.
With Worksheets("DAY BOOK")
Set rng = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)).Resize(, LISTBOX_COL_COUNT)
End With
'Read the values into an array.
v = rng.Value2
'If no removals are required then just populate with the read array.
If removeItem = vbNullString Then
ListBox1.List = v
Exit Sub
End If
'For removals find the list of matching rows in the array.
Set rowList = New Collection
For r = LBound(v, 1) To UBound(v, 1)
isMatch = False
For c = LBound(v, 2) To UBound(v, 2)
itemText = LCase(CStr(v(r, c)))
If itemText Like removeItem Then
isMatch = True
Exit For
End If
Next
If isMatch Then rowList.Add r
Next
'Size the new list array, based on matching items.
ReDim listItems(1 To rowList.Count, 0 To LISTBOX_COL_COUNT)
'Copy the matchings rows to the new array.
r = 1
For Each rowNum In rowList
For c = LBound(v, 2) To UBound(v, 2)
listItems(r, c) = v(rowNum, c)
Next
r = r + 1
Next
'Populate the listbox with the new array.
ListBox1.List = listItems
pvs:
TextBox1.SetFocus
End Sub
Get column header and date formats
1."... then headerline disappears"
Assuming that there is no RowSource
bound, as this wouldn't cooperate with later dynamic array assignments executed in your post, it suffices to insert rowList.Add 1
immediately after code line Set rowList = New Collection
to include captions as it will be added as first element to the collection (referring to header row 1).
2."... and date fields [columns D and H] are shown in numbers"
Assigning range values to a datafield array via .Value2
results in dates shown as numeric values, so e.g. Jan 4th 2021 in column D would be displayed as 44201
.
If it's only for search matters you could change the code line after section comment 'Read the values into an array.
to v = rng.Value
(instead of .Value2
) displaying the date format due to regional settings, otherwise you'd have to change each single format by a loop through array v
respectively the filtered array listItems
before populating the listbox.
3."(the) first column (is displayed) empty"
If you don't want the first listbox column empty, change the code line after section comment 'Size the new list array, based on matching items.
to
ReDim listItems(1 To rowList.Count, 1 To LISTBOX_COL_COUNT)
Further hint: naming a variable removeItem
if it's used to include items seems contraproductive.