User Define Function used to populate listbox

[paulette33]

Hi -

I am using a user defined function to populate a list box by calling the function in the RowSourceType for that listbox. The function is using a 2 dimensional array to store the values. Everything seems to be working except that the list box is populating with only one of the dimensions for both columns. I discovered this when I "unhid" the bound column, which should be displaying the id. I believe it has to do with how the data is being returned to the function. I am just not sure how to fix and whether it is fixable. Here is the code. Thank you in advance for your help!!

BTW, I pulled the format of the this function from RowSourceType Property (User Defined Function) in Help.

Function fillList(fld As Control, id As Variant, row As Variant, col As Variant, _
                code As Variant) As Variant

Static dbs() As Variant
Static intEntries As Integer
Static intSelected As Integer
Dim varItem As Variant
Dim ReturnVal As Variant

On Error GoTo fillListError

    ReturnVal = Null
    
    Select Case code
        Case acLBInitialize                ' Initialize.
            intEntries = 0
            With lstEnviron
                If intList = 1 Then
                    ReDim dbs(1, .ListCount - 1)
                    
                    For intEntries = 0 To .ListCount - 1
                        dbs(0, intEntries) = .Column(0, intEntries)
                        dbs(1, intEntries) = lstEnviron.Column(1, intEntries)
                    Next
                
                ElseIf intList = 2 Then
                    intSelected = .ItemsSelected.Count - 1
                    
                    If blnHasData = True Then
                        dbs = arrSelected
                        intEntries = UBound(arrSelected, 1) + 1
                        intSelected = intSelected + intEntries
                        
                    End If
                    
                    ReDim Preserve dbs(1, intSelected)
                    For Each varItem In .ItemsSelected
                        dbs(0, intEntries) = .Column(0, varItem)
                        dbs(1, intEntries) = .Column(1, varItem)
                        intEntries = intEntries + 1
                    Next
                End If
            
            End With
            ReturnVal = intEntries
        
        Case acLBOpen                        ' Open.
            ' Generate unique ID for control.
            ReturnVal = Timer
        
        Case acLBGetRowCount            ' Get number of rows.
            ReturnVal = intEntries
        
        Case acLBGetColumnCount    ' Get number of columns.
            ReturnVal = 2
        
        Case acLBGetColumnWidth    ' Column width.
            ' -1 forces use of default width.
            ReturnVal = -1
        
        Case acLBGetValue                    ' Get data.
            ReturnVal = dbs(0, row)
            ReturnVal = dbs(1, row)
        Case acLBEnd                        ' End.
            
            Erase dbs
    
    End Select
    fillList = ReturnVal

fillListExit:
    Exit Function

fillListError:
    MsgBox Err.Number & " - " & Err.Description


End Function

 

[PHV]

Replace this:
Case acLBGetValue ' Get data.
ReturnVal = dbs(0, row)
ReturnVal = dbs(1, row)
By this:
Case acLBGetValue ' Get data.
ReturnVal = dbs(col, row)

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ222-2244

 

[paulette33]

Thank you PHV!!!!! It worked!

Paulette33