Solved How to sort a combobox using VBA

[AlliCarr]

Hi

I have a combobox on a reporting form which uses VBA in the On Load event to pull the values from the reports that I have in the database. Although the reports always show alphabetically from a - z in the navigation pane, they don't show in alphabetical order in the combobox. Is there any way I can update the code so that the list is always alphabetical from a - z so it's easier for users to find the report they're looking for?

Here's the code:

Private Sub Form_Load()
On Error GoTo ErrorHandler

'Pulls list of reports for report combo box and updates when new reports added
    Dim NewValList As String
    NewValList = ""
    
    Dim Obj As AccessObject
    
        For Each Obj In CurrentProject.AllReports
            If Right(Obj.Name, 3) <> "Sub" Then
            NewValList = NewValList + Chr(34) + Obj.Name + Chr(34) + ";"
            End If
        Next Obj
    
    Me!ReportCombo.RowSourceType = "Value List"
    Me!ReportCombo.RowSource = NewValList
    Me!ReportCombo.value = Me!ReportCombo.ItemData(0)
    

Exit Sub

ErrorHandler:
    Dim msg As String
    msg = Err.Number & ":" & Err.Description
    MsgBox msg
    
End Sub

I have tried searching online for an answer but can't seem to find anything that I can make work so hopefully someone will be able to point me in the right direction.

 

[Uncle Gizmo]

I would be inclined to collect the report names into a table and then fill the combo box with a suitable query.

The alternative way sticking with code would be as follows:-

Private Sub Form_Load()
    On Error GoTo ErrorHandler

    'Pulls list of reports for report combo box and updates when new reports added
    Dim ReportList As New Collection
    Dim Obj As AccessObject
    Dim i As Integer
    Dim SortedList() As String
    Dim NewValList As String
    
    'Collecting report names
    For Each Obj In CurrentProject.AllReports
        If Right(Obj.Name, 3) <> "Sub" Then
            ReportList.Add Obj.Name
        End If
    Next Obj

    'Sorting report names
    ReDim SortedList(ReportList.Count - 1)
    For i = 1 To ReportList.Count
        SortedList(i - 1) = ReportList(i)
    Next i
    Call QuickSort(SortedList, LBound(SortedList), UBound(SortedList))

    'Creating the value list
    NewValList = ""
    For i = LBound(SortedList) To UBound(SortedList)
        NewValList = NewValList & Chr(34) & SortedList(i) & Chr(34) & ";"
    Next i

    Me!ReportCombo.RowSourceType = "Value List"
    Me!ReportCombo.RowSource = Left(NewValList, Len(NewValList) - 1) ' Remove the last semicolon
    Me!ReportCombo.value = Me!ReportCombo.ItemData(0)

Exit Sub

ErrorHandler:
    Dim msg As String
    msg = Err.Number & ": " & Err.Description
    MsgBox msg

End Sub

'QuickSort function to sort the array
Sub QuickSort(arr() As String, ByVal first As Long, ByVal last As Long)
    Dim v As String
    Dim i As Long, j As Long
    Dim temp As String

    i = first
    j = last
    v = arr((first + last) \ 2)

    Do While i <= j
        Do While arr(i) < v
            i = i + 1
        Loop
        Do While arr(j) > v
            j = j - 1
        Loop
        If i <= j Then
            temp = arr(i)
            arr(i) = arr(j)
            arr(j) = temp
            i = i + 1
            j = j - 1
        End If
    Loop

    If first < j Then QuickSort arr, first, j
    If i < last Then QuickSort arr, i, last
End Sub

 

[Uncle Gizmo]

This section would look tidier in a with block:-

Me!ReportCombo.RowSourceType = "Value List"
Me!ReportCombo.RowSource = Left(NewValList, Len(NewValList) - 1) ' Remove the last semicolon
Me!ReportCombo.value = Me!ReportCombo.ItemData(0)

 

[Uncle Gizmo]

With Me!ReportCombo
    .RowSourceType = "Value List"
    .RowSource = Left(NewValList, Len(NewValList) - 1) ' Remove the last semicolon
    .value = Me!ReportCombo.ItemData(0)
End With

 

[AlliCarr]

Thanks @Uncle Gizmo for your response and the feedback.

I like the idea of adding the report names into a table and using a query for the combobox as this seems a little cleaner. Would I need to add in the report names manually every time I create a new report or can this be done automatically?

 

[arnelgp]

also, you can try this.
add a Module and on that module, paste this code to sort your array:

' https://stackoverflow.com/questions/152319/vba-array-sort-function
'
Public Function sorted_array(ByRef InputArray As Variant) As Variant

Dim arr As Object
Dim element As Variant

'Creating a array list
Set arr = CreateObject("System.Collections.ArrayList")


'number
'InputArray = Array(6, 5, 3, 4, 2, 1)

' adding the elements in the array to array_list
For Each element In InputArray
    arr.Add element
Next

'sorting happens
arr.Sort

'Converting ArrayList to an array
'so now a sorted array of elements is stored in the array sorted_array.

sorted_array = arr.toarray
End Function

now change your code to this:

Private Sub Form_Load()
On Error GoTo ErrorHandler

'Pulls list of reports for report combo box and updates when new reports added
    Dim NewValList As String
    ' arnelgp
    Dim arr() As String, cnt As Integer, i As Integer
    ReDim arr(500)
    
    NewValList = ""
    
    Dim Obj As AccessObject
    
        For Each Obj In CurrentProject.AllReports
            If Right(Obj.Name, 3) <> "Sub" Then
                cnt = cnt + 1
                arr(cnt - 1) = Obj.Name
            End If
        Next Obj
        
        If cnt <> 0 Then
            ReDim Preserve arr(cnt - 1)
            arr = sorted_array(arr)
            
            For i = 0 To cnt
                NewValList = NewValList + Chr(34) + arr(i) + Chr(34) + ";"
            Next
            
            
    
            Me!ReportCombo.RowSourceType = "Value List"
            Me!ReportCombo.RowSource = NewValList
            Me!ReportCombo.Value = Me!ReportCombo.ItemData(0)
        
        End If

Exit Sub

ErrorHandler:
    Dim msg As String
    msg = Err.Number & ":" & Err.Description
    MsgBox msg
    
End Sub

 

[theDBguy]

Perhaps you could also consider pulling the names of your reports from the MSysObjects table, so you can sort it. I forgot the flag value but something like:

select [name] from msysobjects where flag=xxx

Sent from phone...

 

[Uncle Gizmo]

Db Guys idea is a good one. You might have to show your system tables.

(MSysObjects)

Then you could use code something like this:-

Private Sub Form_Load()
    On Error GoTo ErrorHandler

    'Set the RowSource to the query that selects and sorts report names
    Me!ReportCombo.RowSourceType = "Table/Query"
    Me!ReportCombo.RowSource = "SELECT MSysObjects.Name FROM MSysObjects WHERE MSysObjects.Type = -32764 ORDER BY MSysObjects.Name;"
    Me!ReportCombo.value = Me!ReportCombo.ItemData(0)

Exit Sub

ErrorHandler:
    Dim msg As String
    msg = Err.Number & ": " & Err.Description
    MsgBox msg

End Sub

 

[Uncle Gizmo]

In a With Block

With Me!ReportCombo
    .RowSourceType = "Table/Query"
    .RowSource = "SELECT MSysObjects.Name FROM MSysObjects WHERE MSysObjects.Type = -32764 ORDER BY MSysObjects.Name;"
    .value = Me!ReportCombo.ItemData(0)
End With

 

[CJ_London]

I was going to suggest the sql route but you don’t need to make msysobjects visible to use it

I would add one further refinement to the criteria-

[name] not like ‘*sub’

 

[MajP]

@AlliCarr,
The original recommendations of creating and maintaining a table has some advantages. Most people do not have clean descriptive report names, you might. I never do since they are usually prefixed with "rpt" and have no spaces. You may want to display an clear, descriptive name, and it is nice to also store a long description. So you then could have a combo with the nice to read name (ReportVisibleName) and hide the ReportName. You can also show the description in the pull down.

TblReports

ReportName	ReportVisibleName	ReportDescription
rptDeptAccounts	User Accounts (Grouped by Department)	Report contains active email accounts grouped by Departments.
rptAccountTypes	User Accounts (Grouped by Type)	Report contains active email accounts grouped by account type and grouped by Departments.

 

[Gasman]

I had a table tblObject that held info that I would use to run them

 

[MajP]

However if not using a sorted table here is a simpler way to add items to a combo sorted.

Private Sub Command2_Click()
  Dim rpt As Access.AccessObject
  Dim idx As Integer
  For Each rpt In CurrentProject.AllReports
    If Me.cmboReports.ListCount = 0 Then
      Me.cmboReports.AddItem rpt.Name
    Else
      For idx = 0 To Me.cmboReports.ListCount - 1
        If rpt.Name < Me.cmboReports.ItemData(idx) Then
          Me.cmboReports.AddItem rpt.Name, idx
          Exit For
        End If
      Next idx
      If rpt.Name >= Me.cmboReports.ItemData(cmboReports.ListCount - 1) Then Me.cmboReports.AddItem rpt.Name
    End If
  Next rpt
End Sub

When you add a value to the combo simply add the item at the correct location.

 

[CJ_London]

Perhaps not as flexible as a separate table but I use a simple function to add back spaces and remove 'rpt'. Wouldn't work for your TWMFee for example where the alias is 'TWM fees to be invoiced'.

 

[Gasman]

That was all about 7 years ago. Retired now.

 

[AlliCarr]

Db Guys idea is a good one. You might have to show your system tables.

(MSysObjects)

Then you could use code something like this:-

Private Sub Form_Load()
    On Error GoTo ErrorHandler

    'Set the RowSource to the query that selects and sorts report names
    Me!ReportCombo.RowSourceType = "Table/Query"
    Me!ReportCombo.RowSource = "SELECT MSysObjects.Name FROM MSysObjects WHERE MSysObjects.Type = -32764 ORDER BY MSysObjects.Name;"
    Me!ReportCombo.value = Me!ReportCombo.ItemData(0)

Exit Sub

ErrorHandler:
    Dim msg As String
    msg = Err.Number & ": " & Err.Description
    MsgBox msg

End Sub

This looks really straightforward but when I've added it to the code, the combobox comes up blank

[name] not like ‘*sub’

Also tried adding this but no luck. Not sure where I'm going wrong?

 

[AlliCarr]

However if not using a sorted table here is a simpler way to add items to a combo sorted.

Private Sub Command2_Click()
  Dim rpt As Access.AccessObject
  Dim idx As Integer
  For Each rpt In CurrentProject.AllReports
    If Me.cmboReports.ListCount = 0 Then
      Me.cmboReports.AddItem rpt.Name
    Else
      For idx = 0 To Me.cmboReports.ListCount - 1
        If rpt.Name < Me.cmboReports.ItemData(idx) Then
          Me.cmboReports.AddItem rpt.Name, idx
          Exit For
        End If
      Next idx
      If rpt.Name >= Me.cmboReports.ItemData(cmboReports.ListCount - 1) Then Me.cmboReports.AddItem rpt.Name
    End If
  Next rpt
End Sub

When you add a value to the combo simply add the item at the correct location.

I've added this in the on load event of my form and it (sort of) works. The combobox is full and it's sorted a-z but there are some previously deleted reports showing for some reason and some are duplicated at the bottom. In the image below, the Yorkshire Members by LA report is no longer there and the reports after the space are all duplicates shown further up in the list.

I've checked whether I have inadvertently hidden some reports but there's nothing else there. It's very strange!

The only other thing is that I have some sub reports in there that users don't need to see. These all have "Sub" at the end of the report name and the previous code I had accounted for this so I figured I could add in some of that to leave the sub reports out of the list but I can't figure out where to put it.

 

[ebs17]

Wasn't it about sorting?

SELECT
   [Name]
FROM
   MSysObjects
WHERE
   Right([Name], 3) <> "Sub"
ORDER BY
   [Name]

 

[MajP]

I believe the reason for the duplicate is in this line where it is possible to add an item twice.

If rpt.Name >= Me.cmboReports.ItemData(cmboReports.ListCount - 1) Then Me.cmboReports.AddItem rpt.Name

Try this version. However as people have suggested using a query on the system table or creating a reports table is probably a better approach.

Private Sub LoadReports()
  Dim rpt As Access.AccessObject
  Dim idx As Integer
  Dim added As Boolean
  For Each rpt In CurrentProject.AllReports
    added = False
    If Me.cmboReports.ListCount = 0 And Right(rpt.Name, 3) <> "sub" Then
      Me.cmboReports.AddItem rpt.Name
      added = True
    Else
      For idx = 0 To Me.cmboReports.ListCount - 1
        If rpt.Name < Me.cmboReports.ItemData(idx) And Right(rpt.Name, 3) <> "sub" Then
          Me.cmboReports.AddItem rpt.Name, idx
          added = True
          Exit For
        End If
      Next idx
      If Not added And Right(rpt.Name, 3) <> "sub" Then Me.cmboReports.AddItem rpt.Name
    End If
  Next rpt
End Sub

 

[Pat Hartman]

I like the idea of adding the report names into a table and using a query for the combobox as this seems a little cleaner. Would I need to add in the report names manually every time I create a new report or can this be done automatically?

I do this so that I can have a properly formatted object name for the report but a pretty name that is displayed to the user for picking. There is no event you can use that would automagically add a newly created report to the definition table.

The other alternative is to use a query on the MSysObjects system table and select only the report types. Using this method, you will need to be disciplined in how you name reports so you can use a prefix that allows you to pick the reports to display and ignore subreports or system reports. You can sort the reports in this query so they display consistently