AddAllToList With Column Headers

[Denburt]

This function was originally created back in the dawn of time, over the years I have made a number of changes and after searching the net I still didn't see 1 that allowed for the use of column headers so I thought I would post one that does.

On the controls property simply click yes or no for Column Headers and off you go.

You can use the Tag property to determine the column and the words displayed.
2;<No Selection>

To help save a click this Function will also select the Item in the list that you just added, this is commented in the lower portion of the function in case you decide to remove it.

If you need further information on the implementation of this function you can find that here:
http://support.microsoft.com/kb/128881

Function AddAllToList(ctl As Control, lngID As Long, lngRow As Long, _
lngCol As Long, intCode As Integer) As Variant
On Error GoTo Err_AddAllToList
      Static dbs As Database, rst As Recordset
      Static lngDisplayID As Long
      Static intDisplayCol As Integer
      Static strDisplayText As String
      Static ctlVal As String
      Dim intSemiColon As Integer
      Select Case intCode
         Case acLBInitialize
            If lngDisplayID <> 0 Then
               MsgBox "AddAllToList is already in use by another control!"
               AddAllToList = False
               Exit Function
            End If
            If ctl.Tag > "" Then
                intSemiColon = InStr(ctl.Tag, ";")
               If intSemiColon = 0 Then
                  intDisplayCol = Val(ctl.Tag)
               Else
                  intDisplayCol = Val(Left(ctl.Tag, intSemiColon - 1))
                  strDisplayText = Mid(ctl.Tag, intSemiColon + 1)
               End If
            Else
                intDisplayCol = 1
                strDisplayText = "(All)"
            End If
            ctlVal = strDisplayText
            Set dbs = CurrentDb
            Set rst = dbs.OpenRecordset(ctl.RowSource, dbOpenSnapshot)
            lngDisplayID = Timer
            AddAllToList = lngDisplayID
         Case acLBOpen
            AddAllToList = lngDisplayID
         Case acLBGetRowCount
            On Error Resume Next
            rst.MoveLast
            If ctl.ColumnHeads = True Then
                AddAllToList = rst.RecordCount + 2
            Else
                AddAllToList = rst.RecordCount + 1
            End If
         Case acLBGetColumnCount
            AddAllToList = rst.Fields.Count
         Case acLBGetColumnWidth
            AddAllToList = -1
         Case acLBGetValue
            If ctl.ColumnHeads = True Then
                If lngRow = 0 Then
                        AddAllToList = rst.Fields(lngCol).Name
                ElseIf lngRow = 1 Then
                    If lngCol = intDisplayCol - 1 Then
                        AddAllToList = strDisplayText
                    Else
                        AddAllToList = Null
                    End If
                Else
                    rst.MoveFirst
                    rst.Move lngRow - 2
                    AddAllToList = rst(lngCol)
                End If
            Else
                If lngRow = 0 Then
                    If lngCol = intDisplayCol - 1 Then
                        AddAllToList = strDisplayText
                    Else
                        AddAllToList = Null
                    End If
                Else
                    rst.MoveFirst
                    rst.Move lngRow - 1
                    AddAllToList = rst(lngCol)
                End If
            End If
         Case acLBEnd
            lngDisplayID = 0
            rst.Close
'The following if statement selects the item in the list that you have just added
            If ctlVal <> "" Then
                ctl.Value = ctlVal
            End If
            Set rst = Nothing
            Set dbs = Nothing
      End Select
Bye_AddAllToList:
      Exit Function
 
Err_AddAllToList:
    MsgBox Err.Description, vbOKOnly + vbCritical, "AddAllToList"
    AddAllToList = False
    Resume Bye_AddAllToList
End Function

[FishVal]

Almost the same: MS Access Calculated List