Why Can I not get headers in my list box

[Andrew1234]

Hi all.
I have a table that is constantly being added to and i am trying to make a userform to search through the data. At present i think the search function working but i cannot get the table headers to become headers in my listbox. As the table is being added to frequently i have a dynamic range which is referenced in the Engine sheet.

here is the code i am using for the search function.

Private Sub TextBox1_Change()

 With Me.ListBox1
 .Clear
    For ColHead = 2 To 9
     .AddItem
     .List(0, ColHead - 2) = Sheets("Product Data").Cells(18, ColHead).Value
    Next ColHead
 ListRow = 1
 If IsDate(Me.TextBox1) Then
    FindVal = CDate(Me.TextBox1)
    ElseIf IsNumeric(Me.TextBox1) Then FindVal = Val(Me.TextBox1)
    Else
    FindVal = "*" & Me.TextBox1 & "*"
 End If
 ProductRng = Sheets("Engine").Range("B3").Value
 LastRow = ProductRng + 18
 For ShRow = 19 To LastRow
    FindRow = Application.WorksheetFunction.CountIf(Sheets("Product Data").Rows(ShRow).EntireRow, "*" & FindVal & "*")
    If FindRow > 0 Then
      For ListCol = 2 To 9
       .AddItem
       .List(ListRow, ListCol - 2) = Sheets("Product Data").Cells(ShRow, ListCol).Value
      Next ListCol
    ListRow = ListRow + 1
   End If
  Next ShRow
  End With

End Sub

i have tried to add in
ListBox1.ColumnHeads = True
and then adjust the row number down one to compensate. but the headers will not populate text and unfortunatly i have a very limited understanding of vba.

here is also an image of the userform

As you can see the header bar is empty and the header is below. this is my issue.

As you can see i also have an issue as the list box is showing a huge number of empty rows. if there is a simple coding solution i would also be thankful.



many thanks to all in advance,

Andrew

 

[DanteAmor]

Hi @Andrew1234. Thanks for posting on the forum.

Some comments:

1. For the ColumnHeads property to work, loading into the listbox must be done with the RowSource property.​

2. If the headers are in row 18, then the upload should be done from row 19.
3. In this case, since you are selecting the records that meet a condition, you cannot load from the same sheet, since the RowSource property will not respect the filters or the records that meet the condition.
4. For these cases, what I recommend is to transfer the records that meet the condition to an auxiliary sheet.
5. The auxiliary sheet will have the headers in row 1 and from row 2 downwards the records that met the condition.
6. Now the listbox can be loaded with the rowsource property from the auxiliary sheet.​

7. I remind you that your macro looks for the data in the entire row, but in your load you only load the columns from B to I, if the data exists in column A, then you will not see it in the listbox.​

8. Then create a sheet called "Auxiliary", even after your tests you can hide the sheet.​

9. Put the following in the activate event of your userform:​

Private Sub UserForm_Activate()
  With ListBox1
    .ColumnHeads = True
    .RowSource = ""
    .ColumnCount = 8
  End With
End Sub

if there is a simple coding solution i would also be thankful.

It is not a simple solution, but I already prepared the code for you to filter and have your headers.
Put the following code in your userform.

Private Sub TextBox1_Change()
  Dim FindVal As Double, FindDat As Date, FindTxt As String
  Dim LastRow As Long
  Dim sh1 As Worksheet, sht As Worksheet
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long, m As Long
  
  ListBox1.RowSource = ""

  With TextBox1
    If IsDate(.Value) Then
      FindDat = CDate(.Value)
    ElseIf IsNumeric(.Value) Then
      FindVal = Val(.Value)
    Else
      FindTxt = "*" & LCase(.Value) & "*"
    End If
  End With
  
  Set sh1 = Sheets("Product Data")
  Set sht = Sheets("Auxiliar")
  
  LastRow = sh1.Range("A:J").Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
  a = sh1.Range("A19:I" & LastRow).Value
  
  ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
  For i = 1 To UBound(a, 1)
    For j = 1 To UBound(a, 2)
      If a(i, j) <> "" Then
        If a(i, j) = FindDat Or a(i, j) = FindVal Or LCase(a(i, j)) Like FindTxt Then
          k = k + 1
          For m = 2 To UBound(a, 2)
            b(k, m - 1) = a(i, m)
          Next
          Exit For
        End If
      End If
    Next
  Next
  
  If k > 0 Then
    sht.Cells.ClearContents
    sht.Range("A1").Resize(1, 8).Value = sh1.Range("B18").Resize(1, 8).Value
    sht.Range("A2").Resize(k, 8).Value = b
    ListBox1.RowSource = sht.Range("A2:H" & k + 1).Address(external:=True)
  End If
End Sub

--------------
Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
--------------

 

[Andrew1234]

Hi @DanteAmor Thank you for your time and effort writing a reply.

I will show you all of the code in this Userform. Just to give you the whole picture. Also i must let you know I found a piece of coding to clear empty rows from the listbox and it is working well.
You will notice at the bottom of this code i have copied your first piece of code in the hope of solving the column header issue. but unfortunately i cannot get it to work. Have i applied it correctly?
See below the full code. I hope this makes sense.

Private Sub TextBox1_Change()

 With Me.ListBox1
 .Clear
    For ColHead = 2 To 9
     .AddItem
     .List(0, ColHead - 2) = Sheets("Product Data").Cells(19, ColHead).Value
    Next ColHead
 ListRow = 1
 If IsDate(Me.TextBox1) Then
    FindVal = CDate(Me.TextBox1)
    ElseIf IsNumeric(Me.TextBox1) Then FindVal = Val(Me.TextBox1)
    Else
    FindVal = "*" & Me.TextBox1 & "*"
 End If
 ProductRng = Sheets("Engine").Range("B3").Value
 LastRow = ProductRng + 18
 For ShRow = 19 To LastRow
    FindRow = Application.WorksheetFunction.CountIf(Sheets("Product Data").Rows(ShRow).EntireRow, "*" & FindVal & "*")
    If FindRow > 0 Then
      For ListCol = 2 To 9
       .AddItem
       .List(ListRow, ListCol - 2) = Sheets("Product Data").Cells(ShRow, ListCol).Value
      Next ListCol
    ListRow = ListRow + 1
   End If
  Next ShRow
  End With
 
'''Begin deleting empty rows in listbox'''
Dim i As Long

' loop backwards through items,
For i = ListBox1.ListCount - 1 To 0 Step -1
    ' check each if it contains meaningful text
    If Trim(ListBox1.List(i) & vbNullString) = vbNullString Then
        ' if not, delete that item
        ListBox1.RemoveItem (i)
    End If
Next i
''' End deleting empty rows in listbox'''
 
 
End Sub


Private Sub CommandButton3_Click()

Unload Search_UF

End Sub

Private Sub UserForm_Initialize()

 'ListBox1.ColumnHeads = True
'''Begin populating listbox'''
With Me.ListBox1
 .Clear
    For ColHead = 2 To 9
     .AddItem
     .List(0, ColHead - 2) = Sheets("Product Data").Cells(19, ColHead).Value
    Next ColHead
 ListRow = 1
 If IsDate(Me.TextBox1) Then
    FindVal = CDate(Me.TextBox1)
    ElseIf IsNumeric(Me.TextBox1) Then FindVal = Val(Me.TextBox1)
    Else
    FindVal = "*" & Me.TextBox1 & "*"
 End If
 ProductRng = Sheets("Engine").Range("B3").Value
 LastRow = ProductRng + 18
 For ShRow = 19 To LastRow
    FindRow = Application.WorksheetFunction.CountIf(Sheets("Product Data").Rows(ShRow).EntireRow, "*" & FindVal & "*")
    If FindRow > 0 Then
      For ListCol = 2 To 9
       .AddItem
       .List(ListRow, ListCol - 2) = Sheets("Product Data").Cells(ShRow, ListCol).Value
      Next ListCol
    ListRow = ListRow + 1
   End If
  Next ShRow
  End With
'''End populating listbox'''


'''Begin deleting empty rows in listbox'''
Dim i As Long

' loop backwards through items,
For i = ListBox1.ListCount - 1 To 0 Step -1
    ' check each if it contains meaningful text
    If Trim(ListBox1.List(i) & vbNullString) = vbNullString Then
        ' if not, delete that item
        ListBox1.RemoveItem (i)
    End If
Next i
''' End deleting empty rows in listbox'''


End Sub

Private Sub UserForm_Activate()
 
  With ListBox1
    .ColumnHeads = True
    .RowSource = Sheets("Product Data").Range("B18:I18")
    .ColumnCount = 8
  End With
End Sub

I must also address your comments.
Yes the column headers that i would like to show are on row 18 column B to I

At present i do have good userform that will search through the data from the product data sheet this function works well. The only area i cannot achieve is getting the column headers. It has been a struggle for what would seem a simple task.


And again, Many thanks for your efforts!

 

[DanteAmor]

I don't think you paid attention to my notes.
To load the header you must use the RowSource property to load the data and in your code you are using the AddItem method.

Delete all your code and use my code.

Do tests with my code, you will see that the filters and the header work.

I put my code again:

Private Sub TextBox1_Change()
  Dim FindVal As Double, FindDat As Date, FindTxt As String
  Dim LastRow As Long
  Dim sh1 As Worksheet, sht As Worksheet
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long, m As Long
  
  ListBox1.RowSource = ""

  With TextBox1
    If IsDate(.Value) Then
      FindDat = CDate(.Value)
    ElseIf IsNumeric(.Value) Then
      FindVal = Val(.Value)
    Else
      FindTxt = "*" & LCase(.Value) & "*"
    End If
  End With
  
  Set sh1 = Sheets("Product Data")
  Set sht = Sheets("Auxiliar")
  
  LastRow = sh1.Range("A:J").Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
  a = sh1.Range("A19:I" & LastRow).Value
  
  ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
  For i = 1 To UBound(a, 1)
    For j = 1 To UBound(a, 2)
      If a(i, j) <> "" Then
        If a(i, j) = FindDat Or a(i, j) = FindVal Or LCase(a(i, j)) Like FindTxt Then
          k = k + 1
          For m = 2 To UBound(a, 2)
            b(k, m - 1) = a(i, m)
          Next
          Exit For
        End If
      End If
    Next
  Next
  
  If k > 0 Then
    sht.Cells.ClearContents
    sht.Range("A1").Resize(1, 8).Value = sh1.Range("B18").Resize(1, 8).Value
    sht.Range("A2").Resize(k, 8).Value = b
    ListBox1.RowSource = sht.Range("A2:H" & k + 1).Address(external:=True)
  End If
End Sub

Private Sub UserForm_Activate()
  With ListBox1
    .ColumnHeads = True
    .RowSource = ""
    .ColumnCount = 8
  End With
End Sub

Private Sub CommandButton3_Click()
  Unload Search_UF
End Sub

Note Code Tag:
In future please use code tags when posting code.
How to Post Your VBA Code it makes your code easier to read and copy and it also maintains VBA formatting.

I share my test file with the code so you can see how it works.

userform rowsource.xlsm

drive.google.com

--------------
I hope to hear from you soon.
Respectfully
Dante Amor
--------------

 

[Andrew1234]

Hi @DanteAmor thank you for you help unfortunately at the beginning I wasn't able to get your code to work but with the help of certain lines in your code i got sorted.

Many thanks,
Andrew