Formatting a listbox alternative

Question

I need to format my listbox - So demonstrate my listbox pulls my data correctly I have this code which works:

SOLUTION: I have managed to get the control working, not to how I need it but it now displays data. I had to change the SQL which is now set to:

strSQL = "SELECT [_tbl_Structure].[User Name], Sum(tbl_RTI.[Credit]) AS SumOfCredit, Count(tbl_RTI.Credit) AS Volume FROM _tbl_Structure INNER JOIN tbl_RTI ON [_tbl_Structure].[User ID] = tbl_RTI.CDP GROUP BY [_tbl_Structure].[User Name];"

Code:

Stats.RowSource = "SELECT [_tbl_Structure].[User Name], Sum(CCur([Credit])) AS [Total Credit], Count(tbl_RTI.Credit) AS Volume FROM _tbl_Structure INNER JOIN tbl_RTI ON [_tbl_Structure].[User ID] = tbl_RTI.CDP GROUP BY [_tbl_Structure].[User Name], [_tbl_Structure].[Supervisor ID] HAVING ((([_tbl_Structure].[Supervisor ID])=[Forms]![frm_Managers_Stats_TeamView_Daily]![EI]));"

Now I need to implement this into a Microsoft Listview Control - I have the following code but nothing is displayed in the control:

Code:

On Error GoTo err_handle
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Variables
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Dim lvxObj As ListView
    Dim lstItem As ListItem
    Dim rs As DAO.Recordset
    Dim fld As DAO.Field
    Dim iColWidth As Integer
    Dim i As Integer
    Dim strSQL As String

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Set the SQL statement for our recordsource
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

'By using the SQL 'AS' keyword, we can give our columns custom names...

        strSQL = "SELECT [_tbl_Structure].[User Name], Sum(CCur([Credit])) AS [Total Credit], Count(tbl_RTI.Credit) AS Volume FROM _tbl_Structure INNER JOIN tbl_RTI ON [_tbl_Structure].[User ID] = tbl_RTI.CDP GROUP BY [_tbl_Structure].[User Name], [_tbl_Structure].[Supervisor ID] HAVING ((([_tbl_Structure].[Supervisor ID])=[Forms]![frm_Managers_Stats_TeamView_Daily]![EI]));"

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'  Set up List View object, and invoke a recordset based on the SQL
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Set lvxObj = lvxEmployees.Object
        Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'  Clear any items in the current list.
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        lvxObj.ListItems.Clear

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Clear existing, then add new column headers
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

'code loops through the open recordset's field names (the custom
'ones with set using the AS keyword, if you remember) and sets them
'as our ListViews columnheaders.
'We also set the column widths to be all the same, which is calculated
'by taking the width of the ListView itself, divided by the number of
'columns.  I minus 20 of the end of each one, to ensure all fields are
'visible completely (not hanging over the edge of the listview).


            With lvxObj.ColumnHeaders
            .Clear
                For i = 0 To rs.Fields.Count
                    For Each fld In rs.Fields
                        If i = 0 Then
                         iColWidth = 0 ' This hides the first ID column from the user, but retains it's value as the identifying property
                        Else
                         iColWidth = (lvxEmployees.Width / (rs.Fields.Count - 1)) - 20
                        End If
                     .Add , , fld.Name, iColWidth
                     i = i + 1
                    Next fld
                Next i
            End With

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Check values present in recordset
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    If rs.BOF Then
        'No data has been returned .. no need to add the items to the
    ' list view.
    Else
        'Records present.. setting up list of items

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Add in list items, with colour based on criteria of if the
' employee is active or not.
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        rs.MoveFirst

        While Not rs.EOF
            For i = 0 To rs.Fields.Count
                If i = 0 Then
                    Set lstItem = lvxObj.ListItems.Add(, , Nz(Trim(rs(i)), "")) ' Set the value of the first column of the row

            'Set the Colour based on criteria
            If rs("Total Credit") >= 0 Then
             lstItem.ForeColor = vbBlack ' Black if not active
            Else
             lstItem.ForeColor = vbRed ' Red if active
            End If
                ElseIf i < rs.Fields.Count Then
                    lstItem.SubItems(i) = Nz(Trim(rs(i)), "") ' set the subsequent columns, known as subitems.

             'Repeat Colour setting based on criteria, for the subitems
            If rs("Total Credit") >= 65 Then
             lstItem.ForeColor = vbBlack ' Black if not active
            Else
             lstItem.ForeColor = vbRed ' Red if active
            End If
                Else
                End If
            Next i
            rs.MoveNext
        Wend
    End If


'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Close off & Cleanup
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    rs.Close

err_handle:
    Select Case Err.Number
        Case 0
         'ignore, not an Error
        Case Else
     'Handle error Appropriately.
    End Select

From viewing the code above is there anything that jumps out that I am potentially missing?

Errors:

To few parameters. Expected 1

Although not the cause of the problem - the `err_handle` label and code should go between `Exit Sub` and `End Sub` so it's not part of the main body of code. — Darren Bartrup-Cook, Apr 03 '18 at 09:59
I managed to get it working - Not like I wanted it. It only shows the names of people with forcolours set. Not listed like a listbox would — dmorgan20, Apr 03 '18 at 10:05
Good stuff. Might be worth adding your solution as an answer so other people can learn from it. Going back to the `err_handle` problem - where you have the `'Handle error Appropriately.` comment add a message box or `debug.assert false`. I have a feeling your code will run that line every time and not just when an error occurs. — Darren Bartrup-Cook, Apr 03 '18 at 10:09
Thank you - I have also added Debug.Assert False (I don't see anything appearing in the immediate window. What exactly does this do? — dmorgan20, Apr 03 '18 at 10:16
It should just stop the code at that point - the same as putting a break-point in the code. I'm just trying to show that the code after your `err_handle:` label executes every time and not just when an error occurs. Error handling should be outside the main body of code - after an `Exit Sub` statement, but before the `End Sub` statement. — Darren Bartrup-Cook, Apr 03 '18 at 10:20
Thank you for the advice - I am still struggling with my original post unfortunately. Simple SQL works, adding in a criteria is when it seems to debug saying too few parameters. Any ideas? — dmorgan20, Apr 03 '18 at 10:32
This answer should help with the parameters: [Too Few Parameters](https://stackoverflow.com/questions/32832275/openrecordset-method-issue-with-too-few-parameters). If not this should give everything you need to know: [Everything About Using Parameters from Code](https://msdn.microsoft.com/en-us/library/office/aa160564(v=office.11).aspx) — Darren Bartrup-Cook, Apr 03 '18 at 11:06

Formatting a listbox alternative

0 Answers0