Search code examples
vbalistboxuserform

How to Set Column Header and Format Columns in VBA ListBox?


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

  • the headerline disappears and
  • date fields are shown as numbers before and after search (How to format the date columns)

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

Solution

  • 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.