Excel VBA - MultiColumn ListBox Column Headers

I have a multicolumn listbox (14 columns)

It is on a userform.

I have a horiztonal scrollbar as the listbox width exceeds the width of the userform.

The problem is my column headers, which are nothing more than labels I have placed above each column (with much trial and error) on the userform itself.

When I scroll horiztonally the reminder of my columns are displayed just fine, but the columns on the end have no headers because I have no screen space on which to place labels.

Is there a way of creating column headers that are actually a part of the column rather than using the labels?

Hack, Anhn has already showed you in the last thread on how to add column headers...

Is that not what you want?

Sid

If you put .ColumnHeaders = True, column headers will be added.

They are blank...how do I put specific text in each individual column header. I've played around with a variety of things and I can find no .Text property or .Value property or .Etc Property associated with the actual column header itself.

You mean .ColumnHeads = True

AFAIK you can't, you can only get headers if you bind the listbox to a range.

To show the column headers create a temp sheet and hide it in your workbook and then import the data from the database into that temp sheet. Base your listbox from that temp sheet so that you can have column headers.

Let me know if you want an example?

Sid

Here is an example (tested and tried see snapshot). You need to change only where mentioned below.

The code assumes that

a) You have a sheet named "Temp" in your workbook which is hidden.
b) Your database name is Hack.Mdb which is in C:\
c) You want a column width of 50

Code:

---

Private Sub CommandButton1_Click()
    Dim ws      As Worksheet
    Dim nm As Name
    '~~> Change below as applicable
    Const sDBPath = "C:\Hack.mdb"
    Const sConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sDBPath & ";"
    Dim cn      As ADODB.Connection
    Dim rs      As ADODB.Recordset
    Dim sSQL    As String
    Dim i      As Long
    Dim LastRow As Long
   
    Set cn = New ADODB.Connection
    Set rs = New ADODB.Recordset
    '~~> Change below as applicable
    Set ws = Sheets("Temp")
   
    sSQL = "SELECT * FROM table1"
    cn.Open sConn
    rs.Open sSQL, cn, 1, 1
   
    For i = 1 To rs.Fields.Count - 1
        ws.Cells(1, i).Value = rs.Fields(i).Name
    Next
   
    LastRow = 2
   
    With Me.ListBox1
        .Clear
        .ColumnHeads = True
        If rs.RecordCount < 1 Then
            .ColumnCount = 1
            .AddItem "No record found"
        Else
            .ColumnCount = rs.Fields.Count
            Do While Not rs.EOF
                For i = 1 To rs.Fields.Count - 1
                    If IsNull(rs.Fields(i)) Then ws.Cells(LastRow, i).Value = "" Else _
                    ws.Cells(LastRow, i).Value = rs.Fields(i)
                Next
                LastRow = LastRow + 1
                rs.MoveNext
            Loop
            ActiveWorkbook.Names.Add Name:="Hack", _
            RefersToR1C1:="=Temp!R2C1:R" & LastRow & "C" & rs.Fields.Count
            .RowSource = "Hack"
            '~~> Change below as applicable
            .ColumnWidths = "50;50;50;50;50;50;50;50;50;50;50;50;50;50"
            .TopIndex = 0
        End If
    End With
    rs.Close: Set rs = Nothing
    cn.Close: Set cn = Nothing
End Sub

---

Hope this helps.

Sid

Was strugling for last 2 days... and I found this today... took half an hour to customize and job done... thanks SID...